'este programa importa una hoja de excel a una tabla de access
Option Compare Database
Dim wRuta, wTabla, varchivo, Var, vdirec As String
Dim i, wLong As Integer
Dim db As DAO.Database, rs As DAO.Recordset
Private Sub Form_Load()
Me.Lista.Value = ""
If Lista.ListCount > 0 Then
For i = Me.Lista.ListCount - 1 To 0 Step -1
Me.Lista.RemoveItem (i)
Next
End If
Me.Lista.Requery
Me.Etiqueta_Aviso.Visible = False
End Sub
Private Sub cmdBuscar_Click()
vdirec = "c:\"
'Limpio la lista
Me.Lista.Value = ""
If Lista.ListCount > 0 Then
For i = Me.Lista.ListCount - 1 To 0 Step -1
Me.Lista.RemoveItem (i)
Next
End If
'adiciono el mensaje a la lista
Me.Lista.AddItem ("Archivo Encontrados")
Me.Lista.Requery
'
Set fs = Application.FileSearch
With fs
.LookIn = vdirec
.FileName = "*.xls"
If .Execute(SortBy:=msoSortbyFileName, SortOrder:=msoSortOrderAscending) > 0 Then
For i = 1 To .FoundFiles.Count
Me.Lista.AddItem (.FoundFiles(i))
Next i
Else
MsgBox "No se ha encontrado ninguna hoja de Excel"
End If
End With
Me.Lista.Requery
Me.cmdImportar.Enabled = False
End Sub
Private Sub cmdimportar_Click()
Dim mensaje, Título, xMotivo As String
vRes = MsgBox("¿Estas seguro que desea importar el contenido de esta archivo? ", vbQuestion + vbYesNo, "Aviso")
If vRes = 7 Then
Exit Sub
End If
Me.Etiqueta_Aviso.Visible = True
Me.Repaint
'Obtiene ruta y nombre de la tabla
For i = 1 To Me.Lista.ListCount - 1
If Me.Lista.Selected(i) Then
varchivo = Trim(Me.Lista.Column(0, i))
End If
Next
'separa la Unidad y la ruta
wRuta = ""
wTabla = ""
wLong = 0
For i = Len(varchivo) To 1 Step -1
wLong = wLong + 1
If Mid(varchivo, i, 1) = "\" Then
wRuta = Mid(varchivo, 1, i)
wTabla = Mid(varchivo, (i + 1), wLong)
i = 0
End If
Next
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "menaje", varchivo, True, "menaje!"
MsgBox "Impotación terminada....", vbInformation, "Aviso del Sistema"
Etiqueta_Aviso.Visible = False
Exit Sub
End Sub
Sub EjecutaVar()
'End Sub
With DoCmd
.SetWarnings False
.RunSQL Var
.SetWarnings True
End With
End Sub
Private Sub Lista_Click()
Me.cmdImportar.Enabled = True
End Sub
Private Sub Comando2_Click()
DoCmd.Close
End Sub