VBA宏。我正在尝试将csv文件加载到访问数据库中

时间:2016-05-04 03:23:06

标签: excel vba excel-vba

我正在尝试编写一个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

2 个答案:

答案 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

希望有所帮助