#
Mit Microsoft Access ist es manchmal notwendig, zwischengespeicherte Tabellen komplett zu einem SQL-Server hochzuladen.
Dabei kann man entweder Datensatz für Datensatz einzeln hochübertragen mit Kontrolle einer GUID oder eindeutigen ID
Oder man gleich die komplette Tabelle hochladen

Leider gehen dabei die Indexe, ID-Felder und Memo-Formate kaputt.
Diese kann man aber einfach korrigieren beim Upload

Das folgende Code-Beispiel zeigt einen kompletten Upload einer Tabelle.
Wichtig ist dabei die folgende Zeile
DoCmd.TransferDatabase(acExport, "ODBC Database", "ODBC;Driver={SQL Server};SERVER=.\SQLExpress;Trusted_Connection=yes;Database=" & sDatabase, acTable, sTabelle, sTabelle_Temp, False)
Diese Zeile führt den Kompletten Upload als Bulk-Operation durch




Public Function fl_Sys_Tabelle_Upload(ByVal sTabelle As String, Optional ByVal bLog As Boolean = True) As Boolean
'----------------< fl_Sys_Tabelle_Upload >----------------
'< Kontrolle >
'*lokale _Daten.mdb pruefen
If accDB Is Nothing Then
MsgBox("the lokal data container is missing", vbCritical, "check .._daten.mdb")
Exit Function
End If
'</ Kontrolle >

Dim bOK As Boolean
bOK = True

'< init >
Dim sAccess_Datei As String
If bLog Then addLog("-< Upload " & sTabelle & ">-", Me)
'</ init >

'< Kontrolle >
If sTabelle Like "" Then
MsgBox("Tabellename ist leer. Abbruch.", vbCritical, "Upload")
Exit Function
End If
'</ Kontrolle >


'-< init >-
'< .DSN >
Dim sDatabase As String
sDatabase = fg_SQL_getSetting_local("Database")
'< /.DSN >
'< Tempname >
Dim sTabelle_Temp As String
sTabelle_Temp = sTabelle & "_temp_" & fg_Sys_getWinUser
'</ Tempname >
'-</ init >-



'< kontrolle >
If sDatabase Like "" Then
addStatus "Database-Name ist leer. Abbruch Upload"
Exit Function
End If
'</ kontrolle >


'--< Ziel-TempTabelle Loeschen >--
If bLog Then addLog("< loesche Express-TempZiel >", Me)
'< loeschen >
Dim sSQL As String
sSQL = "DROP TABLE [" & sTabelle_Temp & "]"
On Error Resume Next
fg_ADO_Execute(sSQL, False, "local")
'< loeschen >
If Err.Number <> 0 Then
addLog("-", Me)
Else
addLog("ok", Me)
End If
If bLog Then addLog "</ loesche Express-TempZiel >"
'--< Ziel-TempTabelle Loeschen >--

'---< Quelletabelle auswerten >--
Dim sIDFeld As String
Dim objTabledef As DAO.TableDef
addLog("< Quelltabelle auswerten >", Me)
On Error Resume Next
objTabledef = accDB.TableDefs(sTabelle)
If Err.Number <> 0 Then
addStatus(Err.Description, Me)
addStatus("! Die Tabelle " & sTabelle & " konnte nicht in Vespa_Daten gefunden werden. Abbruch.", Me)
Exit Function
End If
'< primary ermitteln >
Dim objField As DAO.Field
Dim objIndex As DAO.index
For Each objIndex In objTabledef.Indexes
If objIndex.Primary = True Then
sIDFeld = objIndex.Fields(0).Name
addLog("IDFeld=" & sIDFeld, Me)
Exit For
End If
Next
If sIDFeld Like "" Then
sIDFeld = DLookup("IDFeldname", "tbl_SERVICE_connect", "Tabelle like '" & sTabelle & "'")
addLog("IDfeld aus Vorgabe _extern entnehmen.", Me)
End If
If sIDFeld Like "" Then
addLog("IDfeld konnte nicht ermittelt werden. Abbruch", Me)
addStatus(sTabelle & "->IDFeld festlegen", Me)
'Exit Function
End If
'</ primary ermitteln >
addLog("</ Quelltabelle auswerten >", Me)
'---</ Quelletabelle auswerten >--




'--< Export >--
If bLog Then addLog "< Export von SQL-Server >"
On Error Resume Next
'*achtung remote ueber accDB
'*Immer auf .\SQLExpress !!
accAPP.DoCmd.TransferDatabase(acExport, "ODBC Database", "ODBC;Driver={SQL Server};SERVER=.\SQLExpress;Trusted_Connection=yes;Database=" & sDatabase, acTable, sTabelle, sTabelle_Temp, False)
If Err.Number <> 0 Then
addStatus(Err.Description, Me)
addStatus("! Die Tabelle " & sTabelle & " konnte nicht Exportiert werden ", Me)
bOK = False
Else
addLog("ok ", Me)
bOK = True
End If
If bLog Then addLog("</ Export von SQL-Server >", Me)
'--</ Export >--





'--< Timestamp korrektur >--
If bLog Then addLog("< Timestamp korrektur >", Me)
'< loeschen >
sSQL = "ALTER TABLE " & sTabelle_Temp
sSQL = sSQL & " DROP COLUMN timestamp"
On Error Resume Next
fg_ADO_Execute(sSQL, False, "local")
If Err.Number <> 0 Then
addStatus Err.Description
addStatus("!Das Feld timestamp für die Tabelle " & sTabelle & " konnte nicht gelöscht werden.", Me)
bOK = False
Else
addLog("ok ", Me)
End If
'</ loeschen >
'< anfuegen >
sSQL = "ALTER TABLE " & sTabelle_Temp
sSQL = sSQL & " ADD timestamp timestamp NULL"
On Error Resume Next
fg_ADO_Execute(sSQL, False, "local")
If Err.Number <> 0 Then
addStatus(Err.Description, Me)
addStatus("!Das Feld timestamp für die Tabelle " & sTabelle & " konnte nicht angefuegt werden.", Me)
bOK = False
Else
addLog("ok ", Me)
End If
'</ anfuegen >
If bLog Then addLog "</ Timestamp korrektur >"
'--</ Timestamp korrektur >--


'--< korrektur ntext >--
If bLog Then addLog("< ntext korrektur >", Me)
For Each objField In objTabledef.Fields
If Not objField Is Nothing Then
If objField.Type = 12 Then 'Memo
sSQL = "ALTER TABLE " & sTabelle_Temp & " ALTER COLUMN " & objField.Name & " NVARCHAR(max) NULL"
On Error Resume Next
fg_ADO_Execute(sSQL, False, "local")
End If
End If
Next
If bLog Then addLog("< ntext korrektur >", Me)
'--< korrektur ntext >--


'-< Zieltabelle loeschen >-
If bLog Then addLog("< Zieltabelle loeschen >", Me)
sSQL = "DROP TABLE " & sTabelle
On Error Resume Next
fg_ADO_Execute(sSQL, False, "local")
If Err.Number <> 0 Then
addStatus(Err.Description, Me)
addStatus("Die Zieltabelle konnte nicht gelöscht werden " & sTabelle, Me)
bOK = False
Else
addLog("ok ", Me)
End If
If bLog Then addLog("</ Zieltabelle loeschen >", Me)
'-</ Zieltabelle loeschen >-


'-< TempTabelle Umbenennen >-
If bLog Then addLog("< Tabelle_Temp Umbenennen >", Me)
sSQL = "EXEC sp_rename '" & sTabelle_Temp & "','" & sTabelle & "';"
On Error Resume Next
fg_ADO_Execute(sSQL, , "local")
If Err.Number <> 0 Then
addStatus(Err.Description, Me)
addStatus("Die Temp-Tabelle konnte nicht umbenannt werden " & sTabelle_Temp & " zu " & sTabelle, Me)
bOK = False
Else
addLog("ok ", Me)
End If
If bLog Then addLog("</ Tabelle_Temp Umbenennen >", Me)
'-</ TempTabelle Umbenennen >-

'--< IDFeld NOT NULL >--
If objTabledef(sIDFeld).Required = False Then
If objTabledef(sIDFeld).Type = 4 Then '4=Integer
If bLog Then addLog("< IDFeld NOT NULL >", Me)
sSQL = " ALTER TABLE " & sTabelle
sSQL = sSQL & " ALTER COLUMN [" & sIDFeld & "] INTEGER NOT NULL"
On Error Resume Next
fg_ADO_Execute(sSQL, False, "local")
If Err.Number <> 0 Then
addStatus(Err.Description, Me)
addStatus("!Spalte [" & sIDFeld & "] konnte nicht auf NOT NULL gesetzt werden. " & vbCrLf & "Tabelle=" & sTabelle, Me)
bOK = False
Else
addLog("ok ", Me)
End If
If bLog Then addLog("</ IDFeld NOT NULL >", Me)
Else
If bLog Then addStatus("IDFeld in Daten NOT NULL festlegen.only integers", Me)
End If
End If
'--</ IDFeld NOT NULL >--




'--< ID+Incement setzen >--
If bLog Then addLog("< Primaerschluessel erstellen >", Me)
sSQL = " ALTER TABLE " & sTabelle
sSQL = sSQL & " ADD CONSTRAINT ix" & sTabelle & " PRIMARY KEY CLUSTERED (" & sIDFeld & ")"
sSQL = sSQL & " WITH( STATISTICS_NORECOMPUTE = OFF, IGNORE_DUP_KEY = OFF, ALLOW_ROW_LOCKS = ON, ALLOW_PAGE_LOCKS = ON) ON [PRIMARY]"
On Error Resume Next
fg_ADO_Execute(sSQL, False, "local")
If Err.Number <> 0 Then
addStatus(Err.Description, Me)
addStatus("!Es konnte kein Primärschlüssel füe die Tabelle " & sTabelle & " erstellt werden.", Me)
bOK = False
Else
addLog("ok ", Me)
End If
If bLog Then addLog("</ Primaerschluessel erstellen >", Me)
'--</ ID+Incement setzen >--

'< return >
If bOK = True Then
addStatus("ok " & sTabelle, Me)
Else
addStatus("Fehler " & sTabelle, Me)
End If
'</ return >

'< Abschluss >
If bLog Then addLog("-</ Upload " & sTabelle & ">-", Me)
'</ Abschluss >
'----------------</ fl_Sys_Tabelle_Upload >----------------
End Function
Mobile

.