|
|
@@ -326,7 +326,7 @@ Private Function TableExists(ByVal TName As String) As Boolean
|
|
|
|
|
|
' See if the name is in the Tables collection.
|
|
|
test = Db.TableDefs(TName).name
|
|
|
- If err.number <> NAME_NOT_IN_COLLECTION Then Found = True
|
|
|
+ If err.Number <> NAME_NOT_IN_COLLECTION Then Found = True
|
|
|
|
|
|
' Reset the error variable.
|
|
|
err = 0
|
|
|
@@ -357,9 +357,14 @@ Private Function TableExportSql(ByVal tbl_name As String) As String
|
|
|
count = 0
|
|
|
For Each fieldObj In rs.Fields
|
|
|
DoEvents
|
|
|
- If count > 0 Then VCS_String.Sb_Append sb, ", "
|
|
|
- VCS_String.Sb_Append sb, "[" & fieldObj.name & "]"
|
|
|
- count = count + 1
|
|
|
+ If fieldObj.Type <> 109 And _
|
|
|
+ fieldObj.Type <> 101 And _
|
|
|
+ fieldObj.Type <> 11 Then 'ignore muliple choices fields, ole, and attached fields
|
|
|
+
|
|
|
+ If count > 0 Then VCS_String.Sb_Append sb, ", "
|
|
|
+ VCS_String.Sb_Append sb, "[" & fieldObj.name & "]"
|
|
|
+ count = count + 1
|
|
|
+ End If
|
|
|
Next
|
|
|
|
|
|
TableExportSql = VCS_String.Sb_Get(sb)
|
|
|
@@ -367,6 +372,7 @@ End Function
|
|
|
|
|
|
' Export the lookup table `tblName` to `source\tables`.
|
|
|
Public Sub ExportTableData(ByVal tbl_name As String, ByVal obj_path As String)
|
|
|
+On Error GoTo err
|
|
|
Dim FSO As Object
|
|
|
Dim OutFile As Object
|
|
|
Dim rs As DAO.Recordset ' DAO.Recordset
|
|
|
@@ -378,7 +384,7 @@ Public Sub ExportTableData(ByVal tbl_name As String, ByVal obj_path As String)
|
|
|
logger "ExportTableData", "ERROR", "Table " & tbl_name & " missing"
|
|
|
Exit Sub
|
|
|
End If
|
|
|
-
|
|
|
+
|
|
|
Set rs = CurrentDb.OpenRecordset(TableExportSql(tbl_name))
|
|
|
If rs.RecordCount = 0 Then
|
|
|
'why is this an error? Debug.Print "Error: Table " & tbl_name & " empty"
|
|
|
@@ -413,15 +419,18 @@ Public Sub ExportTableData(ByVal tbl_name As String, ByVal obj_path As String)
|
|
|
If IsNull(value) Then
|
|
|
value = vbNullString
|
|
|
Else
|
|
|
+ On Error GoTo errData
|
|
|
value = Replace(value, "\", "\\")
|
|
|
value = Replace(value, vbCrLf, "\n")
|
|
|
value = Replace(value, vbCr, "\n")
|
|
|
value = Replace(value, vbLf, "\n")
|
|
|
value = Replace(value, vbTab, "\t")
|
|
|
+ On Error GoTo err
|
|
|
End If
|
|
|
OutFile.Write value
|
|
|
Next
|
|
|
OutFile.Write vbCrLf
|
|
|
+next_field:
|
|
|
rs.MoveNext
|
|
|
Loop
|
|
|
rs.Close
|
|
|
@@ -432,8 +441,17 @@ Public Sub ExportTableData(ByVal tbl_name As String, ByVal obj_path As String)
|
|
|
VCS_File.ConvertUcs2Utf8 tempFileName, Path
|
|
|
logger "ExportTableData", "DEBUG", "Data from '" & tbl_name & "' exported to " & Path
|
|
|
FSO.DeleteFile tempFileName
|
|
|
+
|
|
|
+ Exit Sub
|
|
|
+err:
|
|
|
+ logger "ExportTableData", "ERROR", err.Description
|
|
|
+ Exit Sub
|
|
|
+errData:
|
|
|
+ logger "ExportTableData", "ERROR", "[" & fieldObj.name & "] field > Uneadable data"
|
|
|
+ Resume next_field
|
|
|
End Sub
|
|
|
|
|
|
+
|
|
|
' Kill Table if Exists
|
|
|
Private Sub KillTable(ByVal tblName As String, Db As Object)
|
|
|
If TableExists(tblName) Then
|
|
|
@@ -600,7 +618,7 @@ Public Sub ImportTableDef(ByVal tblName As String, ByVal directory As String)
|
|
|
'InFile.Close
|
|
|
|
|
|
If Len(strMsg) > 0 Then
|
|
|
- MsgBox strMsg, vbOKOnly, "Correct manually"
|
|
|
+ OA_MsgBox strMsg, vbOKOnly, "Correct manually"
|
|
|
logger "ImportTableDef", "ERROR", strMsg & " - Correct manually"
|
|
|
Else
|
|
|
logger "ImportTableData", "DEBUG", "TableDef '" & tblName & "' imported from " & filepath
|
|
|
@@ -610,6 +628,7 @@ End Sub
|
|
|
|
|
|
' Import the lookup table `tblName` from `source\tables`.
|
|
|
Public Sub ImportTableData(ByVal tblName As String, ByVal obj_path As String)
|
|
|
+ 'On Error GoTo err
|
|
|
Dim Db As Object ' DAO.Database
|
|
|
Dim rs As Object ' DAO.Recordset
|
|
|
Dim fieldObj As Object ' DAO.Field
|
|
|
@@ -624,6 +643,7 @@ Public Sub ImportTableData(ByVal tblName As String, ByVal obj_path As String)
|
|
|
tempFileName = VCS_File.TempFile()
|
|
|
|
|
|
Path = obj_path & tblName & ".txt"
|
|
|
+
|
|
|
VCS_File.ConvertUtf8Ucs2 Path, tempFileName
|
|
|
|
|
|
' open file for reading with Create=False, Unicode=True (USC-2 Little Endian format)
|
|
|
@@ -633,6 +653,7 @@ Public Sub ImportTableData(ByVal tblName As String, ByVal obj_path As String)
|
|
|
Db.execute "DELETE FROM [" & tblName & "]"
|
|
|
Set rs = Db.OpenRecordset(tblName)
|
|
|
buf = InFile.readline()
|
|
|
+
|
|
|
Do Until InFile.AtEndOfStream
|
|
|
buf = InFile.readline()
|
|
|
If Len(Trim$(buf)) > 0 Then
|
|
|
@@ -640,6 +661,7 @@ Public Sub ImportTableData(ByVal tblName As String, ByVal obj_path As String)
|
|
|
c = 0
|
|
|
rs.AddNew
|
|
|
For Each fieldObj In rs.Fields
|
|
|
+ On Error GoTo errField
|
|
|
DoEvents
|
|
|
value = Values(c)
|
|
|
If Len(value) = 0 Then
|
|
|
@@ -653,6 +675,7 @@ Public Sub ImportTableData(ByVal tblName As String, ByVal obj_path As String)
|
|
|
If fieldObj.Type = dbBoolean Then value = CBool(value)
|
|
|
'**
|
|
|
rs(fieldObj.name) = value
|
|
|
+ On Error GoTo err
|
|
|
c = c + 1
|
|
|
Next
|
|
|
rs.update
|
|
|
@@ -665,4 +688,10 @@ Public Sub ImportTableData(ByVal tblName As String, ByVal obj_path As String)
|
|
|
logger "ImportTableData", "DEBUG", "Table data '" & tblName & "' imported from " & Path
|
|
|
|
|
|
FSO.DeleteFile tempFileName
|
|
|
+ Exit Sub
|
|
|
+err:
|
|
|
+ logger "ImportTableData", "ERROR", "Table data '" & tblName & "' : Unable to import"
|
|
|
+ Exit Sub
|
|
|
+errField:
|
|
|
+ logger "ImportTableData", "ERROR", fieldObj.name & " > this field can not be updated"
|
|
|
End Sub
|