Public Sub dbf2access()
Dim cn As New ADODB.Connection() ' это панятно
Dim r As New ADODB.Recordset ' это понятно
Dim dbf As New VisualFoxpro.FoxApplication ' сам Mr. фокс про
Dim fd As New OpenFileDialog ' файл диалог
Dim f As New Microsoft.Office.Interop.Access.Application 'аксс
f.OpenCurrentDatabase(Application.StartupPath & "\db.accdb", False) ' открываю бд
f.DoCmd.RunSQL("DELETE gdb1.* FROM gdb1;") 'удалаю таблу
Dim lnk As String ' путь
'Dim l As String
With fd
.Filter = "Visual Foxpro files (*.dbf)|*.dbf|All files (*.*)|*.*" ' критерия диалога
End With
For i As Integer = 1 To 6 'у меня 6 дбф-ов для каждова из них
Try
fd.ShowDialog() ' выбераем
If fd.FileName = "" Then ' если нет
f.Application.Quit(Microsoft.Office.Interop.Access.AcQuitOption.acQuitSaveNone)
f = Nothing
dbf.Quit()
dbf = Nothing
Exit Sub
Else ' если есть
lnk = fd.FileName
dbf.DoCmd("USE '" & lnk & "' SHARED") ' открываем
dbf.DoCmd("COPY TO " & Application.StartupPath & "\1.xls TYPE XL5") ' экспорт в екзел
f.DoCmd.TransferSpreadsheet(Microsoft.Office.Interop.Access.AcDataTransferType.acImport, , i, Application.StartupPath & "\1.xls", 1) 'импорт в бд
f.DoCmd.RunSQL("INSERT INTO gdb1 SELECT " & i & ".*FROM " & i & ";") ' дабавлаем в таблу
f.DoCmd.DeleteObject(Microsoft.Office.Interop.Access.AcObjectType.acTable, i) 'удалаем временую таблу
Kill(Application.StartupPath & "\1.xls") ' удалаем екзел
End If
Catch ' при ошибке
f.Application.Quit(Microsoft.Office.Interop.Access.AcQuitOption.acQuitSaveNone)
f = Nothing
dbf.Quit()
dbf = Nothing
MsgBox("error")
Exit Sub
End Try
fd.FileName = ""
Next i
cn.Open("con_str", "юзер", "пароль") 'потключаемся к SQL
r = cn.Execute("DROP TABLE gdb1") 'удалаем таблу
r = Nothing
cn.Close()
f.DoCmd.TransferDatabase(Microsoft.Office.Interop.Access.AcDataTransferType.acExport, "ODBC Database", _
"ODBC;DSN=*;UID=****;PWD=*********;LANGUAGE=us_english;" _
& "DATABASE=db", Microsoft.Office.Interop.Access.AcObjectType.acTable, "gdb1", "gdb1") ' експорт в SQL
f.Application.Quit(Microsoft.Office.Interop.Access.AcQuitOption.acQuitSaveAll) ' выход
f = Nothing
dbf.Quit()
dbf = Nothing
End Sub
|