Set objConn = CreateObject("ADODB.Connection")
strDBPath = "C:\Temp\Users.accdb"
strTextFile = "C:\Temp\Users.txt"
Set objFSO = CreateObject("Scripting.FileSystemObject")
intForReading = 1
If objFSO.FileExists(strDBPath) = True Then
strMDBPath = objFSO.GetFile(strDBPath).ShortPath
objConn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strDBPath & ";Persist Security Info=False;"
'objConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & ";"
'objConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & ";Jet OLEDB:Database Password=password;"
'objConn.Open "Driver={Microsoft Access Driver (*.mdb)}; DBQ=" & strDBPath & ";"
Set objFile = objFSO.OpenTextFile(strTextFile, intForReading, False)
strFields = ""
strValues = ""
While Not objFile.AtEndOfStream
strLine = Trim(objFile.ReadLine)
If strLine <> "" Then
If InStr(strLine, "=") > 0 Then
strFieldName = Trim(Left(strLine, InStr(strLine, "=") - 1))
strValue = Trim(Mid(strLine, InStr(strLine, "=") + 1))
If strFields = "" Then
strFields = "[" & strFieldName & "]"
Else
strFields = strFields & ",[" & strFieldName & "]"
End If
If strValues = "" Then
strValues = "'" & strValue & "'"
Else
strValues = strValues & ",'" & strValue & "'"
End If
End If
End If
Wend
objFile.Close
strQuery = "INSERT INTO Contacts(" & strFields & ") VALUES (" & strValues & ");"
On Error Resume Next
objConn.Execute(strQuery)
If Err.Number <> 0 Then
MsgBox "Error inserting data with query: " & VbCrLf & strQuery & VbCrLf & "Error " & Err.Number & ": " & Err.Description
Err.Clear
On Error GoTo 0
Else
On Error GoTo 0
MsgBox "Data inserted successfully."
End If
objConn.close
Set objConn = Nothing
Else
MsgBox "Unable to find " & strDBPath
End If
|