https://github.com/walter426/VbaUtilities/blob/master/SqlUtilities.bas
Due to the limitation of the ODBC connection, it is impossible to insert or update all records from access table into the SQLite table in one time. We need to do it in an indirect way like below,
1. Copy the table with data to be appended into a temporary .mdb database
2. Convert the mdb file to SQLite formet.(Java)
http://waltertech426.blogspot.com/2014/01/sqlite-convert-ms-access-mdb-file-into.html
3. Do the appending through SQLite script directly.(Python)
https://github.com/walter426/VbaUtilities/blob/master/SQLiteCmdParser.py
As below function required other functions I have written before, pls refer below repository
https://github.com/walter426/VbaUtilities/
'Execute SQLite Command Set
Public Function ExecuteSQLiteCmdSet(SQLiteDb_path As String, CmdSet As String) As String
On Error GoTo Err_ExecuteSQLiteCmdSet
Dim FailedReason As String
If FileExists(SQLiteDb_path) = False Then
FailedReason = SQLiteDb_path
GoTo Exit_ExecuteSQLiteCmdSet
End If
'Create a SQLite Command file, and then parse it into the Python SQLite Command Parser for execution
Dim SQLiteCmdFile_path As String
Dim iFileNum_SQLiteCmd As Integer
SQLiteCmdFile_path = [CurrentProject].[Path] & "\" & "SQLiteCmd.txt"
iFileNum_SQLiteCmd = FreeFile()
If FileExists(SQLiteCmdFile_path) = True Then
Kill SQLiteCmdFile_path
End If
Open SQLiteCmdFile_path For Output As iFileNum_SQLiteCmd
Print #iFileNum_SQLiteCmd, CmdSet
Close #iFileNum_SQLiteCmd
ShellCmd = "python " & [CurrentProject].[Path] & "\SQLiteCmdParser.py " & SQLiteDb_path & " " & SQLiteCmdFile_path
Call ShellAndWait(ShellCmd, vbHide)
Kill SQLiteCmdFile_path
Exit_ExecuteSQLiteCmdSet:
ExecuteSQLiteCmdSet = FailedReason
Exit Function
Err_ExecuteSQLiteCmdSet:
Call ShowMsgBox(Err.Description)
Resume Exit_ExecuteSQLiteCmdSet
End Function
'Append Table into a SQLite database
Public Function AppendTblToSQLite(Tbl_src_name As String, Tbl_des_name As String) As String
On Error GoTo Err_AppendTblToSQLite
Dim FailedReason As String
If TableExist(Tbl_src_name) = False Then
FailedReason = Tbl_src_name
GoTo Exit_AppendTblToSQLite
End If
If TableExist(Tbl_des_name) = False Then
FailedReason = Tbl_des_name
GoTo Exit_AppendTblToSQLite
End If
'Create Db
Dim TempDb_path As String
TempDb_path = [CurrentProject].[Path] & "\TempDb.mdb"
If FileExists(TempDb_path) = True Then
Kill TempDb_path
End If
Call CreateDatabase(TempDb_path, dbLangGeneral)
'Copy Table into the TempDb
Dim SQL_cmd As String
SQL_cmd = "SELECT * " & vbCrLf & _
"INTO [" & Tbl_des_name & "]" & vbCrLf & _
"IN '" & TempDb_path & "'" & vbCrLf & _
"FROM [" & Tbl_src_name & "] " & vbCrLf & _
";"
RunSQL_CmdWithoutWarning (SQL_cmd)
'Convert TempDb into SQLite
Dim SQLiteDb_path As String
SQLiteDb_path = [CurrentProject].[Path] & "\TempDb.sqlite"
If FileExists(SQLiteDb_path) = True Then
Kill SQLiteDb_path
End If
Dim ShellCmd As String
ShellCmd = "java -jar " & [CurrentProject].[Path] & "\mdb-sqlite.jar " & TempDb_path & " " & SQLiteDb_path
Call ShellAndWait(ShellCmd, vbHide)
SQL_cmd = "ATTACH """ & SQLiteDb_path & """ AS TempDb;" & vbCrLf & _
"INSERT INTO [" & Tbl_des_name & "] SELECT * FROM TempDb.[" & Tbl_des_name & "];"
Call ExecuteSQLiteCmdSet(GetLinkTblConnInfo(Tbl_des_name, "DATABASE"), SQL_cmd)
Kill SQLiteDb_path
Kill TempDb_path
Exit_AppendTblToSQLite:
AppendTblToSQLite = FailedReason
Exit Function
Err_AppendTblToSQLite:
Call ShowMsgBox(Err.Description)
Resume Exit_AppendTblToSQLite
End Function
沒有留言:
張貼留言