CODIGO QUE EXAMINE UNIDADES DE DISCO Y BUSQUE UN ARCHIVO

10/05/2008 - 06:52 por LUIS DANNY SALAS | Informe spam

Hola gracias al que amablemente pueda ayudarme, tengo la macro COLEGA
necesito que en lugar de abrir el archivo NOTA.DBF en la unidad de
disquette( A:\)
busque la ubicacion de ese archivo sea en los discos duros o en algun medio
de almacenamiento externo (llave maya)
y lo abra.
es decir en lugar de abrirlo del disquette , que primero busque donde esta
antes de abrirlo, pues ese archivo puede estar en el disquette , en el disco
duro u en una llave maya.
gracias.

Private Sub COLEGA()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks.Open Filename:="A:\NOTA.DBF"
Range("A1:K5000").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
ThisWorkbook.Sheets("REGISTRO").Range("P165:V166"), CopyToRange:= _
Range("N1"), Unique:=False
ThisWorkbook.Activate
Sheets("CONCENTRADO").Select
Range("F11:F52").Select
Selection.Copy
Windows("NOTA.DBF").Activate
Range("R2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ThisWorkbook.Activate
Application.CutCopyMode = False
Range("A62").Select
Selection.Copy
Windows("NOTA.DBF").Activate
Range("Z1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ThisWorkbook.Activate
Application.CutCopyMode = False
Windows("NOTA.DBF").Activate
Range("M2").Select
With Worksheets("NOTA")
If .[R2] <> "" Then
For Each celda In .Range("R2:R" & .[r65536].End(xlUp).Row)
If celda <> "" Then
celda.Copy
ActiveCell.PasteSpecial xlPasteAll
ActiveCell.Offset(1, 0).Activate
End If
Next
End If
End With
Range("M2").Select
Application.CutCopyMode = False
Windows("NOTA.DBF").Activate
With Range("a1:k5000")
.AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=ThisWorkbook.Worksheets("registro").Range("p165:v166"),
_
Unique:=True
With .SpecialCells(xlCellTypeVisible)
On Error GoTo Ninguno
IIf(.Areas(1).Rows.Count > 1, _
.Areas(1).Cells(2, [Z1] + 2), .Areas(2).Cells(1, [Z1] + 2)).Select
End With
End With
ActiveSheet.ShowAllData
With Worksheets("nota")
.Range(.Range("M2"), .Range("M65536").End(xlUp)).Copy ActiveCell
End With
Ninguno:
Windows("NOTA.DBF").Activate
Range("O1:O38").Select
Selection.ClearContents
ActiveWorkbook.Save
ActiveWindow.Close
ThisWorkbook.Activate
Sheets("CONCENTRADO").Select
Range("D11").Select
Application.DisplayAlerts = True
MsgBox "LAS NOTAS HAN SIDO PASADAS AL DISQUETTE CON EXITO!"

End Sub

Siga el debate

12 respuestas

Tengo una respuesta

DRAGON AGE™: INQUISITION – Matadragones

Leer las respuestas

#1 Héctor Miguel

10/05/2008 - 05:43 | Informe spam

hola, Luis !

... tengo la macro COLEGA necesito que en lugar de abrir el archivo NOTA.DBF en la unidad de disquette( A:\)
busque la ubicacion de ese archivo sea en los discos duros o en algun medio de almacenamiento externo (llave maya) y lo abra.
es decir en lugar de abrirlo del disquette, que primero busque donde esta antes de abrirlo
pues ese archivo puede estar en el disquette, en el disco duro u en una llave maya.

Private Sub COLEGA()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks.Open Filename:="A:\NOTA.DBF"
(... ... ...)

prueba con el siguente ejemplo, copiando/pegando las lineas en un modulo de codigo general/normal...
es una API que lee la estructura de archivos (unidad logica) lo que seria la tabla de alojamiento de archivos (FAT)

solo esta 'preparado' para buscar en unidades locales, si necesitas buscar en unidades desmontables/flash/...
deberas armar un bucle que primero compruebe que la uniad SI esta "preparada/montada/lista/..."
(y/o el orden que habra de buscar) para lo cual, te incluyo los codigos aplicables para cada tipo de unidad ;)

OJO: si existen varias versiones de tu archivo... la que obtienes es LA PRIMERA QUE SE ENCUENTRE <= OJO

1) en el codigo que expones, cambia la linea donde abres el archivo desde la unidad a:
-> de:
Workbooks.Open Filename:="A:\NOTA.DBF"
-> a:
Dim Archivo As String
Archivo = Buscar_archivo("nota.dbf")
If Archivo = "" Then MsgBox Archivo & " NO existe en esta pc !!!": Exit Sub
Workbooks.Open Archivo
' aqui continuan tus acciones normales :) '

2) esto es lo que copias/pegas en un modulo de codigo estandar/general/normal/... -> APARTE de tus codigos:

Option Private Module

Declare Function Busca_en_FAT Lib "ImageHlp.dll" Alias "SearchTreeForFile" _
(ByVal Unidad As String, ByVal Archivo As String, ByVal Reserva As String) As Long

Function Buscar_archivo(ByVal Archivo As String)
Dim Disco As Object, Unidad As String: Buscar_archivo = ""
With CreateObject("Scripting.FileSystemObject")
' Tipos para Disco.DriveType _
0 = "Desconocido" _
1 = "Desmontable" _
2 = "Fijo" _
3 = "Unidad de red" _
4 = "CD-ROM" _
5 = "Disco RAM"
For Each Disco In .Drives
If Disco.DriveType = 2 Then
Unidad = Disco.DriveLetter & ":\": Buscar_archivo = Buscar(Unidad, Archivo)
If Buscar_archivo <> "" Then Exit For
End If: Next: End With
End Function

Function Buscar(Unidad As String, Archivo As String) As String
Dim Pos As Long, Tmp As Long, Reserva As String: On Error GoTo No_existe
Reserva = Space(260): Tmp = Busca_en_FAT(Unidad, Archivo, Reserva)
Pos = InStr(Reserva, vbNullChar)
If Not Pos Then Reserva = Left(Reserva, Pos - 1)
Buscar = Reserva: Exit Function
No_existe:
End Function

saludos,
hector.

Leer las otras respuestas

Preguntas similares

Busqueda sugerida :