Макрос VBA. Я пытаюсь загрузить csv-файл в базу данных access

Я пытаюсь написать макрос 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:Usersamritansh.sDesktopNewExcelAutomationmy.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:Usersamritansh.sDesktopNewExcelAutomationSample.csv") Then
    Set objStream = fso.OpenTextFile("C:Usersamritansh.sDesktopNewExcelAutomationSample.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 ответа

  1. попробуйте С ниже

    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
    
  2. Вы можете попробовать этот код

    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, но вы можете использовать любой тип. Помните, что поля an ADODB.Recordsetможно рассматривать как массив rec(i). Таким образом, используя эту процедуру, ваш код будет выглядеть так

        CSVtoArray myarray,strline
        rec.AddNew
         for j=0 to rec.Items.Count-1
          rs(j)=myarray(j+1)
         rec.Update
    

    Надеюсь, это поможет