Código de Excel - Macro Excel cuando no existe comdlg

Imágen de perfil
Val: 17
Ha disminuido su posición en 4 puestos en Excel (en relación al último mes)
Gráfica de Excel

Macro Excel cuando no existe comdlggráfica de visualizaciones


Excel

Actualizado el 28 de Julio del 2016 por Hugo Arturo (4 códigos) (Publicado el 15 de Julio del 2016)
1.884 visualizaciones desde el 15 de Julio del 2016
hola

en otras macros que he realizado necesito el comdlg para obtener la ruta de los archivos, txt, excel, o bases de access y así poder manipular la información

no quería meterme a macros de excel de 2003, 2007 y menos de 2010, pues en lugar de mejorar, "el proveedor" quita lo que no le gusta y pumm, tuve que hace una macro en excel 2010.

no tiene el comdlg, y buceando un poco en excel encontre esta alternativa

buscar el archivo Application.GetOpenFilename, de esta manera abre una versión de comdlg

1
2
3
4
cells(12, 6).Value = Application.GetOpenFilename( _
     "Excel Files(*.xls;*.xlsx;*.xlsm;*.xla;*.xlam),*.xls;*.xlsx;*.xlsm;*.xla;*.xlam", , _
     "Selecccione el archivo Accountentry Blotter a cargar:")
RutaArch1 = Cells(12, 6).Value

en la celda (12,6) pongo la ruta para que el proto usuario valide que es corecta la ruta
y ese valor lo muevo a una variable RutaArch1, ya que con esa ruta abro el excel correspondiente

una delas cosas buenas es que si necesitaba 4 o mas archivos para no hacerce bola se tenia que tener nas de un comdlg, con esta opcion con Application.GetOpenFilename lo manipulas, en mi caso a 8 archivos diferentes

ya con la ruta del archivo ese excel lo abro como una tabla de base de datos y dependiendo de la version de excel se abre diferente proveedor

1
2
3
4
5
6
7
8
9
10
11
12
13
If VBA.Val(Application.Version) < 12 Then
ExcelStr = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source = '" & RutaArch1 & "''';" & _
"Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";"
ElseIf VBA.Val(Application.Version) < 14 Then
ExcelStr = "Provider=Microsoft.Jet.OLEDB.12.0;" & _
"Data Source = '" & RutaArch1 & "';" & _
"Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";"
Else
ExcelStr = "Provider=Microsoft.ACE.OLEDB.12.0;;" & _
"Data Source = '" & RutaArch1 & "';" & _
"Extended Properties=""Excel 12.0;HDR=YES;\"";"
End If

lo demas es abrir un objeto excel y un recorset

Requerimientos

aplica esta versión para windows 7 a 64 y excel 2010

v1

Actualizado el 28 de Julio del 2016 (Publicado el 15 de Julio del 2016)gráfica de visualizaciones de la versión: v1
1.885 visualizaciones desde el 15 de Julio del 2016
estrellaestrellaestrellaestrellaestrella
estrellaestrellaestrellaestrella
estrellaestrellaestrella
estrellaestrella
estrella

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
cells(12, 6).Value = Application.GetOpenFilename( _
     "Excel Files(*.xls;*.xlsx;*.xlsm;*.xla;*.xlam),*.xls;*.xlsx;*.xlsm;*.xla;*.xlam", , _
     "Selecccione el archivo Accountentry Blotter a cargar:")
RutaArch1 = Cells(12, 6).Value
 
 
If VBA.Val(Application.Version) < 12 Then
ExcelStr = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source = '" & RutaArch1 & "''';" & _
"Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";"
ElseIf VBA.Val(Application.Version) < 14 Then
ExcelStr = "Provider=Microsoft.Jet.OLEDB.12.0;" & _
"Data Source = '" & RutaArch1 & "';" & _
"Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";"
Else
ExcelStr = "Provider=Microsoft.ACE.OLEDB.12.0;;" & _
"Data Source = '" & RutaArch1 & "';" & _
"Extended Properties=""Excel 12.0;HDR=YES;\"";"
End If



Comentarios sobre la versión: v1 (0)


No hay comentarios
 

Comentar la versión: v1

Nombre
Correo (no se visualiza en la web)
Valoración
Comentarios...
CerrarCerrar
CerrarCerrar
Cerrar

Tienes que ser un usuario registrado para poder insertar imágenes, archivos y/o videos.

Puedes registrarte o validarte desde aquí.

Codigo
Negrita
Subrayado
Tachado
Cursiva
Insertar enlace
Imagen externa
Emoticon
Tabular
Centrar
Titulo
Linea
Disminuir
Aumentar
Vista preliminar
sonreir
dientes
lengua
guiño
enfadado
confundido
llorar
avergonzado
sorprendido
triste
sol
estrella
jarra
camara
taza de cafe
email
beso
bombilla
amor
mal
bien
Es necesario revisar y aceptar las políticas de privacidad

http://lwp-l.com/s3600