Importing / cycling worksheets Excel to Access problem

[galantis]

Hi,

I am having problems importing data from Excel file. what i am trying to do is to cycle through the individual sheet in the worksheets. I insert the name of each sheet into the MS Acess table to identify which sheet it belong to.

It looks like it is cycling through the sheet but it is not. My [tbl_Cust_Journal] table has blank fields after the first sheet and xlsht still hold the first sheet data.

can anyone help?

thanks,
Galantis

Private Sub cmdImportExcelJournal_Click()
    Dim xlApp As Excel.Application, xlwbk As Excel.Workbook, xlSht As Excel.Worksheet
    Dim xlAllSht As Excel.Worksheets
    Dim xlRng As Excel.Range, xlCell As Excel.Range
    Dim intRowCount As Long, intColCount As Long, intLastRow As Long, intLastCol As Long
    Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
    
    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
                "Data Source=H:\WorkInProgress\Cust_WC.mdb;"
    Set rs = New ADODB.Recordset
    rs.Open "tbl_Cust_Journal", cn, adOpenKeyset, adLockOptimistic, adCmdTable
    
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If TypeName(xlApp) = "Nothing" Then
        Set xlApp = CreateObject("Excel.Application")
    End If
    xlApp.Visible = True
    xlApp.Workbooks.Open "H:\Accounts Recevieable\Journals - Archived\Apr 05\Debtors Journal.xls"
    Set xlwbk = xlApp.ActiveWorkbook
    'Set xlSht = xlApp.ActiveSheet
    'Set mySheet = xlwbk.Sheets.Item(Me.txtShtNum)
    Set xlAllSht = xlApp.Worksheets
    
    For Each xlSht In xlApp.Worksheets
        Set xlRng = xlSht.Range("A1:H35")
        xlRng.UnMerge
        For intRowCount = 2 To xlRng.Rows.Count
            rs.AddNew
            rs.Fields("CustomerNbr") = xlSht.Range("A" & intRowCount).Value
            rs.Fields("CustomerName") = xlSht.Range("B" & intRowCount).Value
            rs.Fields("Ref") = xlSht.Range("C" & intRowCount).Value
            rs.Fields("JournalNbr") = xlSht.Name
            rs.Fields("Age") = xlSht.Range("E" & intRowCount).Value
            rs.Fields("DebitAmount") = xlSht.Range("F" & intRowCount).Value
            rs.Fields("CreditAmount") = xlSht.Range("G" & intRowCount).Value
            rs.Fields("Date") = xlSht.Range(35, 3).Value
            rs.Update
            rs.MoveNext
        Next
    Next xlSht
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Sub

Private Sub cmdReconMgmtReport_Click()
On Error GoTo Err_cmdReconMgmtReport_Click

    Dim stDocName As String
    Dim stLinkCriteria As String
    stDocName = "frm_Report_Recon_Mgmt"
    DoCmd.OpenForm stDocName, , , stLinkCriteria
    
Exit_cmdReconMgmtReport_Click:
    Exit Sub
Err_cmdReconMgmtReport_Click:
    MsgBox Err.Number & ": " & Err.Description
    Resume Exit_cmdReconMgmtReport_Click
End Sub

 

[reclusivemonkey]

You have this line commented out;

'Set xlSht = xlApp.ActiveSheet

This would only carry out the loop for the active sheet, and so would only do one sheet. I'm not familiar with calling Excel from Access, but I suspect if you do something like;

Set xlSheetCount = Application.Workbooks.Worksheets.Count
For x = 1 to xlSheetCount
Sheets(x).Select
...
Next x

It should work.