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

Preguntas similare

Leer las respuestas

#6 LUIS DANNY SALAS
11/05/2008 - 23:11 | Informe spam
Hice exactamente esto:

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



y me produjo este error:

No se ha definido Sub o Function


"Héctor Miguel" wrote in message
news:%
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.

Respuesta Responder a este mensaje
#7 LUIS DANNY SALAS
11/05/2008 - 23:49 | Informe spam
Perdon, no habia puesto este:



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

ya funciono bien.







"LUIS DANNY SALAS" wrote in message
news:e$
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.





ya funciono b

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




Respuesta Responder a este mensaje
#8 Héctor Miguel
12/05/2008 - 02:01 | Informe spam
hola, Luis !

si (segun parece) eres de los que "se brincan" las instrucciones y solo leen... "por encimita"...
te voy a poner en primer lugar los codigos que no debieras dejar de transcribir a tu modulo :))

si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.

1) lo que debes tener en tu modulo (al principio de este) es lo siguiente:

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

Dim Localizado As String

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

2) la instruccion con la que estabas abriendo tu archivo:
-> Workbooks.Open Filename:="A:\NOTA.DBF"
la vas a sustituir por las siguientes lineas:

Dim Unidad As String, Archivo As String
Archivo = "Nota.dbf"
NuevaBusqueda:
Unidad = ""
On Error Resume Next ' por si el usuario pulsa {Esc} y no selecciona nada '
With CreateObject("shell.application")
Unidad = .BrowseForFolder(0, "Selecciona una unidad", 0, "").items.Item.Path: End With
On Error GoTo 0: If Unidad = "" Then MsgBox "Operacion cancelada !!!", , "": Exit Sub
With CreateObject("scripting.filesystemobject"): Unidad = .GetDriveName(Unidad): End With
If Buscar(Archivo, Unidad) <> "" Then GoTo Continuar
If MsgBox("Deseas intentar en otra unidad ?", vbOKCancel + vbQuestion, _
Archivo & " no se encontro en " & Unidad) = vbOK Then GoTo NuevaBusqueda Else Exit Sub
Continuar:
Workbooks.Open Localizado
' aqui siguen tus acciones normales ... '

__ la consulta original __
... lo unico que necesito es que esta macro despliegue un cuadro
donde le pida seleccionar al usuario la unidad donde se encuentra el archivo, nada mas.
Que el usuario indique si es A:\ o C:\ o cualquier otra unidad extraible, y que luego la macro continue.
Que podria suceder en el momento en que el usuario tenga que seleccionar la unidad?
1) que el archivo Nota.dbf se encuentre efectivamente en esa unidad y la macro siga su camino hasta finalizar
2) que el archivo no se encuentre ahi y que entonces se muestre un mensaje de error y la macro no continue.
3) que el usuario cierre el cuadro de dialogo y que entonces no suceda nada.
El usuario si sabe en cual unidad esta el archivo, por que lo que sucede es a cada profesor nos dan un disquette
(concentrado) para pasar las notas de los estudiantes
pero hay quienes prefieren que se les de el concentrado en la llave maya, o hay quienes copian el disquette al disco duro.

Muy agradecido y con mucha verguenza de molestar tanto.
Respuesta Responder a este mensaje
#9 Héctor Miguel
12/05/2008 - 05:58 | Informe spam
hola, Luis !

Gracias, lo probare



[fuera de tema]...

o... la fecha/hora de tu sistema/pc trae un "adelanto" de 2 horas
o... tu pc/region no actualiza/comparte el ajuste con el "horario de verano" -?-

saludos,
hector.
Respuesta Responder a este mensaje
#10 LUIS DANNY SALAS
12/05/2008 - 06:41 | Informe spam
Gracias, lo probare

"Héctor Miguel" wrote in message
news:
hola, Luis !

si (segun parece) eres de los que "se brincan" las instrucciones y solo
leen... "por encimita"...
te voy a poner en primer lugar los codigos que no debieras dejar de
transcribir a tu modulo :))

si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.

1) lo que debes tener en tu modulo (al principio de este) es lo siguiente:

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

Dim Localizado As String

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

2) la instruccion con la que estabas abriendo tu archivo:
-> Workbooks.Open Filename:="A:\NOTA.DBF"
la vas a sustituir por las siguientes lineas:

Dim Unidad As String, Archivo As String
Archivo = "Nota.dbf"
NuevaBusqueda:
Unidad = ""
On Error Resume Next ' por si el usuario pulsa {Esc} y no selecciona nada
'
With CreateObject("shell.application")
Unidad = .BrowseForFolder(0, "Selecciona una unidad", 0,
"").items.Item.Path: End With
On Error GoTo 0: If Unidad = "" Then MsgBox "Operacion cancelada !!!", ,
"": Exit Sub
With CreateObject("scripting.filesystemobject"): Unidad =
.GetDriveName(Unidad): End With
If Buscar(Archivo, Unidad) <> "" Then GoTo Continuar
If MsgBox("Deseas intentar en otra unidad ?", vbOKCancel + vbQuestion, _
Archivo & " no se encontro en " & Unidad) = vbOK Then GoTo
NuevaBusqueda Else Exit Sub
Continuar:
Workbooks.Open Localizado
' aqui siguen tus acciones normales ... '

__ la consulta original __
... lo unico que necesito es que esta macro despliegue un cuadro
donde le pida seleccionar al usuario la unidad donde se encuentra el
archivo, nada mas.
Que el usuario indique si es A:\ o C:\ o cualquier otra unidad extraible,
y que luego la macro continue.
Que podria suceder en el momento en que el usuario tenga que seleccionar
la unidad?
1) que el archivo Nota.dbf se encuentre efectivamente en esa unidad y la
macro siga su camino hasta finalizar
2) que el archivo no se encuentre ahi y que entonces se muestre un
mensaje de error y la macro no continue.
3) que el usuario cierre el cuadro de dialogo y que entonces no suceda
nada.
El usuario si sabe en cual unidad esta el archivo, por que lo que sucede
es a cada profesor nos dan un disquette
(concentrado) para pasar las notas de los estudiantes
pero hay quienes prefieren que se les de el concentrado en la llave maya,
o hay quienes copian el disquette al disco duro.

Muy agradecido y con mucha verguenza de molestar tanto.




Respuesta Responder a este mensaje
Ads by Google
Help Hacer una preguntaSiguiente AnteriorRespuesta Tengo una respuesta
Search Busqueda sugerida