Excel automation question

[bubba100]

The following code works in Excel and I am trying to change the syntax so that from Access I can control Excel but have had not luck. Thanks for any help.

Dim rngcell As Range
Dim ActiveSht As String
ActiveSht = ActiveSheet.Name
intLstRow = Range("E" & ActiveWorkbook.Sheets(ActiveSht).Rows.Count).End(xlUp).Row
For Each rngcell In ActiveWorkbook.Sheets(ActiveSht).Range("E2:E" & intLstRow).Cells
Select Case rngcell.Value
Case "ST", "FT", "PST", "ST-5"
rngcell.Value = "Trailer"
Case "TT", "TR", "RT"
rngcell.Value = "Tractor"
Case "WR"
rngcell.Value = "Recovery"
Case "TK"
rngcell.Value = "Truck"
End Select
rngcell.Offset(, 16).Value = rngcell
Next rngcell

The code in Access is follows.

Dim varMergeFile As String
Dim XFile As Object
Dim Xsheet As String
Dim ExcelWasRunning As Boolean
Dim DBS As Database
Dim ShtCount, MSG As String
Dim Response
Dim rngCell As Excel.Range
Dim intLstRow As Variable
Dim i As Integer
Dim RS As Recordset
Dim FldName As String
Dim ExFileName As String
Dim ActiveSht As String

Set DBS = CurrentDb()
Set RS = DBEngine(0).Databases(0).OpenRecordset("tblregistrantname")
FldName = RS!FolderName
commondialog1.CancelError = True
commondialog1.InitDir = "C:\My Documents"
commondialog1.Filter = "All CSV Files (*.csv)|*.csv"
commondialog1.Flags = &H1000& Or &H800&
commondialog1.FilterIndex = 1
commondialog1.DialogTitle = " Select The File You Wish To Import "
commondialog1.ShowOpen
varMergeFile = commondialog1.FileName

On Error Resume Next
Set XFile = GetObject(, "Excel.Application")
If Err.Number = 0 Then ExcelWasRunning = True
XFile.ActiveWorkbook.Close savechanges:=True
Err.Clear
If XFile Is Nothing Then
Set XFile = CreateObject("Excel.Application")
ExcelWasRunning = False
End If
XFile.Visible = True
XFile.Workbooks.Add
With XFile.ActiveSheet.QueryTables.Add(Connection:="Text;" & varMergeFile, destination:=Range("A1"))
.Name = "Audit_Vehicle_Report "
.FieldName = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 1, 1, 2, 2, 1, 1, 1, 1, 1, 3, 3, 3, 3)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With

ChDir "C:\My Documents\" & FldName
ActiveWorkbook.SaveAs FileName:= _
Left(varMergeFile, Len(varMergeFile) - 3) & "xls", FileFormat:=xlNormal, Password:="", _
writerespassword:="", ReadOnlyRecommended:=False, CreateBackup:=False

With XFile
ExFileName = ActiveWorkbook.Name
ShtCount = XFile.Application.Sheets.Count
For i = 1 To XFile.Application.Sheets.Count
Xsheet = XFile.Application.Sheets(i).Name
Next i
ActiveSht = ActiveSheet.Name

intLstRow = Range("E" & ActiveWorkbook.Sheets(ActiveSht).Rows.Count).End(xlUp).Row
For Each rngCell In ActiveWorkbook.Sheets(ActiveSht).Range("E2:E" & intLstRow).Cells
Select Case rngCell.Value
Case "ST", "FT", "PST", "ST-5"
rngCell.Value = "Trailer"
Case "TT", "TR", "RT"
rngCell.Value = "Tractor"
Case "WR"
rngCell.Value = "Recovery"
Case "TK"
rngCell.Value = "Truck"
End Select
rngCell.Offset(, 16).Value = rngCell
Next rngCell

End With

 

[PHV]

You have to instantiate an Excel.Application object and use full qualified references with the the other excel objects.

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[bubba100]

PHV- thanks for the response. I believe I did instantiate Excel with
Set XFile = GetObject(, "Excel.Application")
If Err.Number = 0 Then ExcelWasRunning = True
XFile.ActiveWorkbook.Close savechanges:=True
Err.Clear
If XFile Is Nothing Then
Set XFile = CreateObject("Excel.Application")
ExcelWasRunning = False
End If

It IS the - qualified references that is giving me problem.

 

[PHV]

For example, replace this:
ActiveSht = ActiveSheet.Name
with this:
ActiveSht = XFile.ActiveSheet.Name

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[bubba100]

Thanks PHV. Just can't seem to get past,
intLstRow = Range("E" & ActiveWorkbook.Sheets(ActiveSht).Rows.Count).End(xlUp).Row . Nothing seems to correct today.

 

[PHV]

intLstRow = XFile.ActiveWorkbook.Sheets(ActiveSht).Range("E" & XFile.ActiveWorkbook.Sheets(ActiveSht).Rows.Count).End(-4162).Row '-4162=xlUp

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[bubba100]

Sorry PHV, copied your line directly (not retyped) still don't get an error but, =Nothing when I move the mouse over intLstRow. I have used automation to control Excel in other projects but haven't tried this before.

 

[PHV]

Did the code runs OK in excel ?

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[bubba100]

PHV- thanks for pointing me in the correct path--again!!

By changing Dim intLstRow As Variable to Variant the line of code was able to move to the last cell in that range and tell what was in that cell, but I was not able to "make it" give the number of records.
I have used automation before but not this particular function.
Finally replaced the entire line with
intLstRow = XFile.ActiveSheet.Range("A1").CurrentRegion.Rows.Count
This should work as column A "should" always have a value if the other cells on that row are not empty.