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

#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.
Respuesta Responder a este mensaje
#2 LUIS DANNY SALAS
10/05/2008 - 20:05 | Informe spam
GRACIAS Hector como siempre Genial! voy a probarlo.
Lo que pienso podria ser problema es que el archivo exista mas de una vez en
la pc.
la otra opcion seria que la macro despliegue un cuadro de examinar o de
escoger la unidad donde se encuentre el archivo y que una vez que el usuario
selecciona la ubicacion del archivo la macro continue.
como se podria hacer esto?
Gracias.

"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
#3 Héctor Miguel
10/05/2008 - 23:08 | Informe spam
hola, Luis !

... pienso podria ser problema... que el archivo exista mas de una vez en la pc.
... otra opcion seria que la macro despliegue un cuadro de examinar o de escoger la unidad
donde se encuentre el archivo y que una vez que el usuario selecciona la ubicacion del archivo
la macro continue. como se podria hacer esto?



existen mas que suficientes formas y alternativas de mostrar dialogos para seleccionar rutas y archivos
el siguiente ejemplo ABRE el archivo que el usuario seleccione y... si el usuario "decide" cancelar este dialogo..
la macro manda un aviso y termina las acciones (NO continua con el procedimiento pendiente)
=> OJO: tampoco tiene por que ser "el que esperabas"

If Application.Dialogs(xlDialogOpen).Show = False Then
MsgBox "Operacion cancelada por el usuario !!!"
Exit Sub
End If
MsgBox "Ejecutando las acciones normales del codigo ..."

la siguiente alternativa SOLO permite seleccionar el nombre de archivo que le indiques (acciones similares)

Dim Abierto As Boolean
Application.Dialogs(xlDialogOpen).Show "nota.dbf"
On Error Resume Next
Abierto = Len(Workbooks("nota.dbf").Name)
On Error GoTo 0
If Abierto Then GoTo SkipWarning
MsgBox "Operacion cancelada por el usuario !!!"
Exit Sub
SkipWarning:
MsgBox "Ejecutando las acciones normales del codigo ..."

si necesitas mas variantes y alternativas, seria conveniente saber que tipo de "eventualidades" esperas del usuario -???-
considera que en programacion, entre las acciones mas "quema-neuronas" estan (enunciativamente) las siguientes:
- "anticipar" (en la medida de lo posible) las acciones del usuario para poder...
- "evaluar" las consecuencias de ejecutar (o no) un procedimiento y finalmente...
- "disenar" prevenciones o correcciones de errores "involuntarios" (o premeditados?)

saludos,
hector.
Respuesta Responder a este mensaje
#4 LUIS DANNY SALAS
11/05/2008 - 22:36 | Informe spam
Gracias voy a hacer pruebas y te aviso, muchas gracias nuevamnete.
"Héctor Miguel" wrote in message
news:
hola, Luis !

... pienso podria ser problema... que el archivo exista mas de una vez en
la pc.
... otra opcion seria que la macro despliegue un cuadro de examinar o de
escoger la unidad
donde se encuentre el archivo y que una vez que el usuario selecciona la
ubicacion del archivo
la macro continue. como se podria hacer esto?



existen mas que suficientes formas y alternativas de mostrar dialogos para
seleccionar rutas y archivos
el siguiente ejemplo ABRE el archivo que el usuario seleccione y... si el
usuario "decide" cancelar este dialogo..
la macro manda un aviso y termina las acciones (NO continua con el
procedimiento pendiente)
=> OJO: tampoco tiene por que ser "el que esperabas"

If Application.Dialogs(xlDialogOpen).Show = False Then
MsgBox "Operacion cancelada por el usuario !!!"
Exit Sub
End If
MsgBox "Ejecutando las acciones normales del codigo ..."

la siguiente alternativa SOLO permite seleccionar el nombre de archivo que
le indiques (acciones similares)

Dim Abierto As Boolean
Application.Dialogs(xlDialogOpen).Show "nota.dbf"
On Error Resume Next
Abierto = Len(Workbooks("nota.dbf").Name)
On Error GoTo 0
If Abierto Then GoTo SkipWarning
MsgBox "Operacion cancelada por el usuario !!!"
Exit Sub
SkipWarning:
MsgBox "Ejecutando las acciones normales del codigo ..."

si necesitas mas variantes y alternativas, seria conveniente saber que
tipo de "eventualidades" esperas del usuario -???-
considera que en programacion, entre las acciones mas "quema-neuronas"
estan (enunciativamente) las siguientes:
- "anticipar" (en la medida de lo posible) las acciones del usuario para
poder...
- "evaluar" las consecuencias de ejecutar (o no) un procedimiento y
finalmente...
- "disenar" prevenciones o correcciones de errores "involuntarios" (o
premeditados?)

saludos,
hector.

Respuesta Responder a este mensaje
#5 LUIS DANNY SALAS
11/05/2008 - 23:02 | Informe spam
Realmente 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.



Private Sub COLEGA()

Application.ScreenUpdating = False
Application.DisplayAlerts = False


AQUI ES DONDE NECESITO UNA INSTRUCCION QUE MUESTRE UN CUADRO DE DIALOGO PARA
QUE EL USUARIO
SELECCIONE LA UNIDAD Y LUEGO QUE LA MACRO SIGA (logicamente que el archivo
Nota.bdf, se abra desde la unidad que haya sido seleccionda por el usuario)

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






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

... pienso podria ser problema... que el archivo exista mas de una vez en
la pc.
... otra opcion seria que la macro despliegue un cuadro de examinar o de
escoger la unidad
donde se encuentre el archivo y que una vez que el usuario selecciona la
ubicacion del archivo
la macro continue. como se podria hacer esto?



existen mas que suficientes formas y alternativas de mostrar dialogos para
seleccionar rutas y archivos
el siguiente ejemplo ABRE el archivo que el usuario seleccione y... si el
usuario "decide" cancelar este dialogo..
la macro manda un aviso y termina las acciones (NO continua con el
procedimiento pendiente)
=> OJO: tampoco tiene por que ser "el que esperabas"

If Application.Dialogs(xlDialogOpen).Show = False Then
MsgBox "Operacion cancelada por el usuario !!!"
Exit Sub
End If
MsgBox "Ejecutando las acciones normales del codigo ..."

la siguiente alternativa SOLO permite seleccionar el nombre de archivo que
le indiques (acciones similares)

Dim Abierto As Boolean
Application.Dialogs(xlDialogOpen).Show "nota.dbf"
On Error Resume Next
Abierto = Len(Workbooks("nota.dbf").Name)
On Error GoTo 0
If Abierto Then GoTo SkipWarning
MsgBox "Operacion cancelada por el usuario !!!"
Exit Sub
SkipWarning:
MsgBox "Ejecutando las acciones normales del codigo ..."

si necesitas mas variantes y alternativas, seria conveniente saber que
tipo de "eventualidades" esperas del usuario -???-
considera que en programacion, entre las acciones mas "quema-neuronas"
estan (enunciativamente) las siguientes:
- "anticipar" (en la medida de lo posible) las acciones del usuario para
poder...
- "evaluar" las consecuencias de ejecutar (o no) un procedimiento y
finalmente...
- "disenar" prevenciones o correcciones de errores "involuntarios" (o
premeditados?)

saludos,
hector.

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