我正在尝试编写一个VBA宏,它可以将csv文件加载到预定义的访问表中。请帮帮我的朋友。我试图将csv文件内容读入数组的代码行是错误,因为类型不匹配
Sub load_data()
Dim objStream As Variant
Dim objFile As Variant
Dim qry As String
Dim connectionString As String
Dim con As New ADODB.Connection
Dim rs As ADODB.Recordset
Dim i As Integer
i = 0
connectionString = "DBQ=C:\Users\amritansh.s\Desktop\NewExcelAutomation\my.mdb; Driver={Microsoft Access Driver (*.mdb)}"
con.Open connectionString
qry = "SELECT * FROM Table1"
Set rs = New ADODB.Recordset
rs.Open qry
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists("C:\Users\amritansh.s\Desktop\NewExcelAutomation\Sample.csv") Then
Set objStream = fso.OpenTextFile("C:\Users\amritansh.s\Desktop\NewExcelAutomation\Sample.csv", 1, False, 0)
End If
Do While Not objStream.AtEndOfStream
strLine = objStream.ReadLine
ReDim myarray(0)
**myarray = Split(strLine, ",")**
rs.AddNew
rs("FUND") = myarray(0)
rs("ACCOUNT") = myarray(1)
rs("HTFREC") = myarray(2)
rs("F1") = myarray(3)
rs("F2") = myarray(4)
rs("F3") = myarray(5)
rs("F4") = myarray(6)
rs("F5") = myarray(7)
rs("F6") = myarray(8)
rs("F7") = myarray(9)
rs("F8") = myarray(10)
rs("F9") = myarray(11)
rs("F10") = myarray(12)
rs("F11") = myarray(13)
rs("F12") = myarray(14)
rs.Update
i = i + 1
Loop
End Sub
答案 0 :(得分:0)
尝试使用以下
Sub test()
Dim objStream As Variant
Dim myarray1
Dim myarraycount
Dim i
Dim dbloc
Dim myarray()
Dim objFile As Variant
Dim con As ADODB.Connection
Dim rec As ADODB.Recordset
Set con = New ADODB.Connection
Set rec = New ADODB.Recordset
rec.CursorLocation = adUseClient
dbloc = "C:\Users\amritansh.s\Desktop\NewExcelAutomation\xml.mdb"
usernm = "" '<========User Name goes here
pword = "" '<========Password goes here
con.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbloc & ";", usernm, pword
qry = "select * from Table1"
rec.Open qry, con, adOpenDynamic, adLockOptimistic
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists("C:\Users\amritansh.s\Desktop\NewExcelAutomation\Sample.csv") Then ' C:\Users\amritansh.s\Desktop\NewExcelAutomation\Sample.csv"
Set objStream = fso.OpenTextFile("C:\Users\amritansh.s\Desktop\NewExcelAutomation\Sample.csv", 1, False, 0) '("C:\Users\amritansh.s\Desktop\NewExcelAutomation\Sample.csv", 1, False, 0)
End If
Do While Not objStream.AtEndOfStream
strLine = objStream.ReadLine
myarray1 = Split(strLine, ",")
myarraycount = UBound(myarray1)
ReDim myarray(myarraycount)
rec.AddNew
rec("FUND") = myarray1(0)
rec("ACCOUNT") = myarray1(1)
rec("HTFREC") = myarray1(2)
rec("F1") = myarray1(3)
rec("F2") = myarray1(4)
rec("F3") = myarray1(5)
rec("F4") = myarray1(6)
rec("F5") = myarray1(7)
rec("F6") = myarray1(8)
rec("F7") = myarray1(9)
rec("F8") = myarray1(10)
rec("F9") = myarray1(11)
rec("F10") = myarray1(12)
rec("F11") = myarray1(13)
rec("F12") = myarray1(14)
rec.Update
i = i + 1
Loop
End Sub
答案 1 :(得分:0)
您可以尝试此代码
Public Sub CSVtoArray(A() As String, csvline As String, Optional b As
Boolean = False)
'***************************************************************************
'* Array A() will be loaded with csv columns values *
'* cvsline is the csv string to parse *
'* DO NOT USE parameter b. It is only for internal workings *
'***************************************************************************
Dim k As Integer, j As Integer
If Not b Then
ReDim A(0)
CSVtoArray A(), csvline, True
Exit Sub
End If
k = InStr(csvline, ",")
j = UBound(A)
j = j + 1
ReDim Preserve A(j)
If k = 0 Then
A(j) = Trim(csvline)
Exit Sub
End If
A(j) = Trim(Mid(csvline, 1, k - 1))
CSVtoArray A(), Mid(csvline, k + 1), True
End Sub
要保存csv列的数组应声明为String
,但您可以使用任何类型。请记住,ADODB.Recordset
的字段可以被视为数组rec(i)
。因此,使用此例程,您的代码看起来像
CSVtoArray myarray,strline
rec.AddNew
for j=0 to rec.Items.Count-1
rs(j)=myarray(j+1)
rec.Update
希望有所帮助