Import specific fields from Access to Excel (VBA)

[ossuary]

Hello,

I have working code to copy the matching records of an Access table into an Excel worksheet, but now I am trying to modify this code so that I can select a couple of specific fields from the table instead of just copying all of the fields (there are 15 fields in the table, but I only actually need 4 of them for this particular report).

Here is the code I am currently using to copy all of the fields over with the matching records:

Const myDB = "DSD Errors DB tester.mdb"
Private Sub CommandButton4_Click()
  ' Test Field Select button
    Dim cnn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim sSQL As String
    
    sSQL = "SELECT * FROM DSD_Invoice_Requests WHERE `Paid?` IS NULL"
    
    Range("A2:O65536").ClearContents
    Application.EnableEvents = False

  ' Create the database connection
    Set cnn = New ADODB.Connection
    myFile = ThisWorkbook.Path & "\" & myDB
    
    With cnn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .Open myFile
    End With
    
  ' Create the recordset
    Set rst = New ADODB.Recordset
    rst.CursorLocation = adUseServer
    rst.Open Source:=sSQL, ActiveConnection:=cnn, _
        CursorType:=adOpenForwardOnly, LockType:=adLockOptimistic, Options:=adCmdText
    
  ' Transfer data to Excel
    Range("A2").CopyFromRecordset rst
    
  ' Close the connection and clean up references
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
    
    Application.EnableEvents = True
    myRow = Range("A65536").End(xlUp).Row - 1
    MsgBox ("Finished loading " & myRow & " record(s)."), vbInformation, "Data Loaded"
End Sub

How can I modify this so that I put specific fields from the table into columns in Excel that will not line up with the layout of the table? For the sake of the example, let's say that I need fields 2, 4, 6, and 8 of the table to go into columns 1, 2, 3, and 4 in Excel.

Thanks in advance for any help with this.

 

[Starbucks_33]

Thanks that works. I noticed that If I create another workbook and check if the "Acive X" it is still unchecked. So I guess you have to make the reference in your workbook.

 

[nirvana_]

I think this is the exact syntax, please ignore the last post.

Sub InsertData()
    Dim j As Integer
    j = 1
    Do While Not rst.EOF
        Worksheets(1).Cells(j, 1) = rst![fields1]
        Worksheets(1).Cells(j, 2) = rst![fields2]
        Worksheets(1).Cells(j, 3) = rst![fields3]
        Worksheets(1).Cells(j, 7) = rst![fields4]
        j = j + 1
        rst.MoveNext
    Loop
End Sub

 

[RoryA]

Yes - all references are workbook specific.

 

[Starbucks_33]

Can you set a reference automatically with VBA?

 

[ossuary]

I think this is the exact syntax, please ignore the last post.

Sub InsertData()
    Dim j As Integer
    j = 1
    Do While Not rst.EOF
        Worksheets(1).Cells(j, 1) = rst![fields1]
        Worksheets(1).Cells(j, 2) = rst![fields2]
        Worksheets(1).Cells(j, 3) = rst![fields3]
        Worksheets(1).Cells(j, 7) = rst![fields4]
        j = j + 1
        rst.MoveNext
    Loop
End Sub

Just want to report that this also works, but is very slow. Definitely an option if you need only a couple of the fields and don't have a lot of data to load, though.

Thanks for this.

 

[RoryA]

It's much quicker to put the data into arrays and write them to the sheet than to go cell by cell.
You can set references with VBA as long as you have programmatic access to the VBProject trusted.

 

[ossuary]

It's much quicker to put the data into arrays and write them to the sheet than to go cell by cell.
You can set references with VBA as long as you have programmatic access to the VBProject trusted.

Would you mind posting an example of what this would look like, to split the data into two arrays and then send those to the Excel sheet? I was playing around with it last night and couldn't seem to get it to work.

 

[RoryA]

Here's some sample code to get an array, transpose it and write it to the sheet (TR is a range variable). You can adapt that hopefully by changing the column counter variables depending on which array you were writing to:

   With rst
      ' get array from recordset
      ' array will be columns * rows so needs to be transposed
      vardata = .GetRows
      ' get column count
      lngFieldCount = .Fields.Count
      ' get row count
      lngRecCount = UBound(vardata, 2) + 1
      ' output field names
      For i = 1 To lngFieldCount
         TR.Offset(0, i - 1) = .Fields(i - 1).Name
      Next i
      ' close recordset
      .Close
   End With
   ' array to hold data
   ReDim avarData(1 To lngRecCount, 1 To lngFieldCount)
   ' loop through the array, writing columns to rows of new array
   For j = 1 To lngRecCount
      For i = 1 To lngFieldCount
         avarData(j, i) = vardata(i - 1, j - 1)
      Next i
   Next j
   ' size destination array and write data to it.
   Range(TR.Offset(1, 0), TR.Offset(UBound(vardata, 1) + 1, UBound(vardata, 2) + 1)).Value = avarData

 

[ossuary]

Excellent, I'll play around with that some this afternoon when I have some time to spare. Thanks again.