Question

I’m trying to run a module in Access 2003 that takes an excel file, if there is info in the cell, then copy the field header and cell in A1, B1, etc… as it loops through each row. There are also comments in the cells with data that need to be copied.

So in a perfect scenario the code would go through each row, cell by cell, and grab the user, the date, the cell’s data and the comment and create a new record in an already existing access table. If the cell is empty then it will be bypassed. I have 4 sheets and I know how to make code loop, I just can’t get access to pull from excel at all.

I don’t want to just import data either, it needs to be sorted with comments in tact.

Any advice would be greatly appreciated. Thanks!

Below is the closest I think I’ve gotten btw:

Sub copy3()

Dim rs2 As New ADODB.Recordset
Dim cnn2 As New ADODB.Connection
Dim cmd2 As New ADODB.Command

With cnn2
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=C:\FilePath.xls;" & "Extended Properties=Excel 8.0;"
.Open
End With

Set cmd2.ActiveConnection = cnn2
cmd2.CommandType = adCmdText
cmd2.CommandText = "SELECT * FROM [Jan-Mar$] Where [Name] IS NOT NULL"
rs2.Open cmd2

While Not rs2.EOF
...Not sure what to write here but I got a msgbox to appear...
rs2.MoveNext
Wend

Answer 1

Thanks Remou for the advice and help. This is what finally worked for me:

Set rs = db.OpenRecordset("TestTable")
xl.Visible = False

Set ws = xl.Workbooks.Open("C:\file.xls").Sheets("Jan-Mar")
Set rng = ws.UsedRange

'Row 1 is all dates so start at Row 2
For i = 2 To rng.Rows.Count
    'Column A contains names so start at Column B
    For j = 2 To rng.Rows(i).Cells.Count
        If rng.Cells(i, j) = "" Or rng.Cells(1, j) = "Total" Then

    Else
        On Error Resume Next
        rs.AddNew
        rs!EmployeeName = rng.Cells(i, 1)
        rs!Date = rng.Cells(1, j)
        rs!PointValue = rng.Cells(i, j)
        str = rng.Cells(i, j).Comment.Text
        str = Right(str, Len(str) - 14)
        'MsgBox str
        rs!Comments = str
        rs.Update
    End If
Next
Next
Set rs = Nothing
Set rng = Nothing
ws.Parent.Close
xl.Quit