Counting rows in excel from Access not working.

[darkhat01]

I am having problems with counting rows from access in excel. I error out at the "Sheets("Sheet1").Select, I really am not sure what I am doing wrong??? Here is the whole Code that I am using. Any ideas what I can do?



Dim MapFile As String
Dim GlueLogFile As String

'Set path of Glue log
GlueLogPath = "C:\Documents and Settings\test\My Documents\Test Database\Gluelog.xls"


'Open the Gluelog excel file
Set appExcel = GetObject(GlueLogPath)
MsgBox ("Excel File Gluelog.xls Opened")

'Show spreadsheet on screen
appExcel.Application.Visible = True
appExcel.Parent.Windows(1).Visible = True
MsgBox ("Now show excel file")

MsgBox "Starting RowCount"
Sheets("Sheet1").Select

'Find the Next Blank Row
RowCount = 1
Do
RowCount = RowCount + 1
If IsEmpty(Cells(RowCount, 1)) Then
If IsEmpty(Cells(RowCount + 1, 1)) Then
RowCount = RowCount + 1
Exit Do
End If
End If
Loop


MsgBox "RowCount =" + RowCount


'MsgBox ("Writeing data to GlueLog")
Cells(RowCount, 1).Value = "Yes1"
Cells(RowCount, 2).Value = "Yes2"
Cells(RowCount, 3).Value = "Yes3"
Cells(RowCount, 4).Value = "Yes4"



MsgBox ("Writeing to file")
' Turn prompting OFF and save the sheet with original name
appExcel.Application.DisplayAlerts = False
appExcel.Application.Save
'appExcel.Application.DisplayAlerts = True
appExcel.Application.Quit
MsgBox ("Excel Log File Closed")

End Sub

Thanks,

Darkhat01

 

[easyit]

Hi

Sheets("Sheet1").Select

can be used within excel. Your code executes in access however.
So you're getting a msaccess error, not a exel error.

Below is a function tha formats an excelsheet. You should be able to get your function to work from there.

Function FormatExcelSheet(ByVal strWorkbookName As String)

    Dim objXL As Excel.Application
    Dim objWB As Excel.Workbook
    Dim objSht As Excel.Worksheet
    Dim objRng, objRng2 As Excel.Range
    Dim i As Integer
    Dim boolToggle As Boolean

    On Error GoTo Error_Handler

    Set objXL = CreateObject("Excel.Application")
    objXL.DisplayAlerts = False
    objXL.Visible = False
    Set objWB = objXL.Workbooks.Open(strWorkbookName)

    For i = 1 To objXL.Sheets.Count     'loop thru sheets
        Set objSht = objWB.Sheets(i)    'Select sheet i
        With objSht
            .Activate
            objXL.ActiveWindow.SplitRow = 1
            objXL.ActiveWindow.SplitColumn = 0
            objXL.ActiveWindow.FreezePanes = True
            objXL.ActiveWindow.DisplayGridlines = False
            Set objRng = .Rows("2:1077")
            With objRng
                .Columns.AutoFit
                With .Font
                    .Name = "Tahoma"
                    .Size = 8
                    .Strikethrough = False
                    .Superscript = False
                    .Subscript = False
                    .OutlineFont = False
                    .Shadow = False
                    .Underline = xlUnderlineStyleNone
                    .ColorIndex = xlAutomatic
                End With
            End With

            Set objRng2 = .Range("B2", .Range("B2").End(xlDown))
            boolToggle = True

            If objRng2 Is Nothing Then
                'MsgBox "nothing in Intersected range to be checked"
                GoTo Error_Handler
            End If

            Set objRng = .Rows("1:1")
            With objRng
                .AutoFilter
                .Interior.ColorIndex = 11
                .Interior.Pattern = xlSolid
                With .Font
                    .Color = 2
                    .Name = "Tahoma"
                    .Size = 8
                    .Strikethrough = False
                    .Superscript = False
                    .Subscript = False
                    .OutlineFont = False
                    .Shadow = False
                    .Underline = xlUnderlineStyleNone
                    .ColorIndex = 2
                End With
            End With

            Set objRng = .Rows("1:2048")    '2048 is way beyond what I expect, but if there are more rows - you know what to do!
            With objRng
                .Columns.AutoFit
            End With
        End With
    Next i
    objWB.Sheets(1).Activate    'activate sheet 1
    objWB.Close True

Exit_Handler:
    On Error Resume Next
    objXL.Quit
    Exit Function
Error_Handler:
    MsgBox "Error in function FormatExcelSheet", CurrentUser, (Err.Number & " " & Err.Description)
    'Call LogError("Error in function FormatExcelSheet", CurrentUser, (Err.Number & " " & Err.Description))
    Resume Exit_Handler
End Function

EasyIT

"Do you think that’s air you're breathing?