Я пишу это в четвертый раз, так что терпите меня.Я пытаюсь решить эту проблему весь день, и я чувствую, что я действительно близок к решению, но просто не совсем там.Я прочитал кучу статей о переполнении стека и в других местах, но не могу понять это.Часть этого кода была заимствована из другого решения на SO, а другая, которая не работает должным образом (насколько я могу судить)
Я пытаюсь разрешить пользователю нажимать кнопку вформа в MS Access, которая будет выполнять код VBA, который я имею ниже.
Первая часть кода откроет диалоговое окно, которое позволяет пользователю выбрать папку.В этой папке будут храниться все файлы XML, которые должны быть обновлены в таблице.(Это будет непрерывный процесс)
С этого момента я хотел бы создать цикл, который будет циклически проходить через каждый файл XML и захватывать 5 точек данных (помеченных как serial, CalDueDate, дата, время, и TotalResult ) затем поместите эти 5 полей в таблицу Access.
Я снова и снова запускал решение и отладчик иЯ продолжаю придумывать разные ошибки.Тем не менее, я считаю, что сузил это до одной последней ошибки (скрестив пальцы), и это то, с чем я прошу сообщество помочь.
Private Sub Command4_Click()
'Folder selector'
Dim xStrPath As String
Dim xFileDialog As Object
Dim xFile As String
Dim xCount As Long
'Now merge XML lookup and table entry'
Const cintNumTables As Integer = 1
Dim intInnerLoop As Integer
Dim intOuterLoop As Integer
Dim objDoc As Object
Dim objNode As Object
Dim strFieldList As String
Dim strMsg As String
Dim strSQL As String
Dim strTable As String
Dim strTag As String
Dim strTagList As String
Dim strUID As String
Dim strValueList As String
Dim varTags As Variant
On Error GoTo ErrorHandler
Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
With xFileDialog
.AllowMultiSelect = False
.Title = "Select a Folder to Import XML Files from"
.Show
End With
xStrPath = xFileDialog.SelectedItems(1)
If xStrPath = "" Then Exit Sub
xFile = Dir(xStrPath & "\*.xml")
xCount = 1
Do While xFile <> ""
For intOuterLoop = 1 To cintNumTables
Select Case intOuterLoop
Case 1
strTable = "XMLConvertedTable"
strTagList = "serial,CalDueDate,date,time,overallResult"
strFieldList = "Serial, DateCalibrationDue, DateCalibrated, TimeCalibrated, TestResult"
Case Else
'oops!'
strTable = vbNullString
End Select
If Len(strTable) > 0 Then
varTags = Split(strTagList, ",")
strValueList = "'" & strUID & "'"
For intInnerLoop = 0 To UBound(varTags)
strTag = varTags(intInnerLoop)
strValueList = strValueList & ", '" & "'"
Next intInnerLoop
'works? to this point'
strSQL = "INSERT INTO " & strTable & " (" & strFieldList & ")" & vbNewLine & "Values (" & strValueList & ");"
Debug.Print strSQL
CurrentDb.Execute strSQL, dbFailOnError
End If
Next intOuterLoop
Loop
ExitHere:
Set objNode = Nothing
Set objDoc = Nothing
On Error GoTo 0
Exit Sub
ErrorHandler:
strMsg = "Error " & Err.Number & " (" & Err.Description _
& ") in procedure Try Again"
MsgBox strMsg
GoTo ExitHere
End Sub
SAMPLE XML
<?xml version="1.0" encoding="UTF-8"?>
<resultset>
<info>
<instrument>instrument 1</instrument>
<serial>000000</serial>
<calDueDate>12 June 2019</calDueDate>
<date>May 13 2019</date>
<time>4:48:00 PM</time>
<overallResult>PASS</overallResult>
<opID>Not Used</opID>
ОБНОВЛЕНИЕ
Я отредактировал код, чтобы он выглядел следующим образом, чтобы облегчить путаницу при отслеживании всего.Я также обнаружил, что ошибка лежит где-то в операторе SQL.Я обнаружил, что переменные strTable, strTagList и strFieldList правильно передают код через инструкцию SQL.
Private Sub Command5_Click()
'Folder selector'
Dim xStrPath As String
Dim xFileDialog As Object
Dim xFile As String
Dim xCount As Long
'Now merge XML lookup and table entry'
Const cintNumTables As Integer = 2
Dim intInnerLoop As Integer
Dim intOuterLoop As Integer
Dim objDoc As Object
Dim objNode As Object
Dim strFieldList As String
Dim strMsg As String
Dim strSQL As String
Dim strTable As String
Dim strTag As String
Dim strTagList As String
Dim strUID As String
Dim strValueList As String
Dim varTags As Variant
On Error GoTo ErrorHandler
Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
With xFileDialog
.AllowMultiSelect = False
.Title = "Select a Folder to Import XML Files from"
.Show
End With
xStrPath = xFileDialog.SelectedItems(1)
If xStrPath = "" Then Exit Sub
xFile = Dir(xStrPath & "\*.xml")
Do While xFile <> ""
strTable = "XMLConvertedTable"
strTagList = "serial, CalDueDate, date, time, overallResult"
strFieldList = "Serial, DateCalibrationDue, DateCalibrated,
TimeCalibrated, TestResult"
If Len(strTable) > 0 Then
varTags = Split(strTagList, ",")
'There is an error in the next statement (error 13)'
strValueList = varTags & ",'"
strSQL = "INSERT INTO " & strTable & " (" & _
strFieldList & ")" & "VALUES (" & strValueList & ");"
Debug.Print strSQL
CurrentDb.Execute strSQL, dbFailOnError
End If
Loop
ExitHere:
Set objNode = Nothing
Set objDoc = Nothing
On Error GoTo 0
Exit Sub
ErrorHandler:
strMsg = "Error " & Err.Number & " (" & Err.Description _
& ") in procedure Try Again"
MsgBox strMsg
GoTo ExitHere
End Sub
Я получаю сейчас ошибку
Ошибка13 (несоответствие типов) в процедуре. Повторите попытку
Любая помощь будет принята с благодарностью!
Изображение представления конструктора таблицы доступа