Te muestro un poco de código, espero que te sea de utilidad.
Coloca estas declaraciones al principio de tu formulario (variables globales):
Código:
Dim dbToUse As Database
Dim sPath As String
Dim sSpecifier As String
Dim sChosenRange As String
Abrir un Archivo de Excel:
Bueno para Abrir el Archivo de Excel primero tienes que insertar el control CommondDialog, que te permitirá abrir el cuadro de dialogo, con el filtro indicado (.xls) para poder visualizar unicamente los archivos con esta extensión, esta rutina unicamente te permite seleccionar el archivo, guardar en una variable su ubicación.
Código:
Private Sub Command1_Click()
Set dbToUse = Nothing
On Error Resume Next
With cdlg
.Filter = "Excel 4 Worksheet (*.xls)|*.xls"
.flags = cdlOFNFileMustExist Or cdlOFNHideReadOnly
.CancelError = True
.ShowOpen
If Err.Number = cdlCancel Then
Exit Sub
End If
Select Case .FilterIndex
Case 1 'excel 4
sSpecifier = "Excel 4.0"
Case 2 'lotus
sSpecifier = "Lotus WK1"
End Select
sPath = .filename
End With
Set dbToUse = Workspaces(0).OpenDatabase(sPath, False, False, sSpecifier)
If Err.Number <> 0 Then
MsgBox "error: " & Err.Number & vbCr & Err.Description
Err.Clear
Set dbToUse = Nothing
Exit Sub
End If
lblSheetPath.Caption = sPath
End Sub
cdlg es mi control CommondDialog, lblSheetPath es un label en donde muestro la ubicación del archivo seleccionado.
Un archivo de Excel puede tener más de una hoja de datos, y probablemente los proveedores usen mas de una para actualizar los precios, el siguiente método lo uso para obtener las hojas del archivo de excel, y las coloco en un ListBox para que el usuario decida con cual trabajar, puedes mandar a llamar el procedimiento con un boton, o en automático despues de seleccionar el archivo:
Código:
Private Sub FillSheetList()
lstSheetranges.Clear
Dim OutDB As Database
Dim Temptbl As TableDef
Screen.MousePointer = vbHourglass
Set OutDB = Workspaces(0).OpenDatabase(sPath, False, False, sSpecifier)
If Err.Number <> 0 Then
Set OutDB = Nothing
Err.Clear
Screen.MousePointer = vbDefault
Exit Sub
End If
For Each Temptbl In OutDB.TableDefs
If sSpecifier = "Excel 4.0" Then
If Right$(Temptbl.name, 1) = "$" Then
lstSheetranges.AddItem Left$(Temptbl.name, Len(Temptbl.name) - 1)
End If
ElseIf sSpecifier = "Lotus WK1" Then
If Right$(Temptbl.name, 1) = ":" Then
lstSheetranges.AddItem Left$(Temptbl.name, Len(Temptbl.name) - 1)
End If
End If
Next
Set Temptbl = Nothing
OutDB.Close
Set OutDB = Nothing
Screen.MousePointer = vbDefault
End Sub
lstSheetranges es el ListBox que Utilizo para visualizar las hojas.
Ahora, ya que puedes elegir entre una y otra hoja coloqué un control Data para visualizar cada hoja, cada que el usuario da un clic al nombre de cada una.
Código:
Private Sub lstSheetranges_Click()
Dim xfor As Integer
Dim yfor As Integer
Screen.MousePointer = vbHourglass
On Error Resume Next
sChosenRange = lstSheetranges.List(lstSheetranges.ListIndex)
'se llena el control data con los datos de la hoja
dtaSampleData.Connect = sSpecifier & ";"
dtaSampleData.DatabaseName = sPath
dtaSampleData.RecordSource = sChosenRange & "$"
faRangeSample.Redraw = False
dtaSampleData.Refresh
faRangeSample.Redraw = True
If Err.Number <> 0 Then
With faRangeSample
faRangeSample.Redraw = True
End With
dtaSampleData.Database.Close
Err.Clear
sChosenRange = ""
End If
Screen.MousePointer = vbDefault
regcount.Caption = dtaSampleData.Recordset.RecordCount & " registros encontrados"'label
colcount.Caption = faRangeSample.Cols - 1 & " columnas"
'llenar los combos
For xfor = 0 To 13
cbofuente(xfor).Clear
For yfor = 0 To faRangeSample.Cols - 1
cbofuente(xfor).AddItem dtaSampleData.Recordset.Fields(yfor).name
Next yfor
Next xfor
End Sub
cbofuente es un combo que utilice para poner todas las columnas de la hoja del archivo de excel, como te das cuenta conectas el control data directamente con el archivo de excel para que lo muestre, especificamente con la hoja que seleccionas:
Código:
dtaSampleData.RecordSource = sChosenRange & "$"
No olvides poner la propiedad Conect del control DATA en "Excel 4.0;" en el cuadro propiedades de VB6.
Bueno al rato te pongo la rutina para pasarlos a la base de datos, por ahora tengo que irme.
Un Saludo.