PDA

View Full Version : Bug in my code that opens up Excel files from Access to edit.


ry94080
06-27-2024, 12:04 PM
Hello all,

I have some code that goes in and check a folder periodically and "processes" the file. The code is below:

I am periodically getting this error message: "462 The remote server machine does not exist or is unavailable". It doesn't happen all the time.

However, when I restart my Access application it processes the file that it was erroring on just fine. I believe it has to do with excel objects being created?

It errors on this line: "Range("B3").Activate"

Please help.



Sub ProcessPriorityCalls(sAffiliatePriorityFile As String)On Error GoTo ProcessPriorityCalls_Err
Dim ExcelApp As Object
Dim Workbook As Object
Dim Worksheet As Object
Dim sDir As String
Dim sfile As String
sDir = "D:\Reports\AffiliatePriorityCalls\"
'
'' Create an instance of Excel
''Set excelApp = CreateObject("Excel.Application")
'Set ExcelApp = New Excel.Application
'ExcelApp.Visible = True
' Open the workbook (replace with your actual file path)
'Set Workbook = ExcelApp.Workbooks.Open(sAffiliatePriorityFile)
'
'' Set the active sheet (you can adjust this as needed)
'Set sheet = Workbook.ActiveSheet
Set ExcelApp = CreateObject("Excel.Application")
ExcelApp.Visible = True
Set Workbook = ExcelApp.Workbooks.Open(sAffiliatePriorityFile)
Set Worksheet = Workbook.Worksheets(1)
WaitFor 100000
Range("B3").Activate
'Do Until ActiveCell.Value = "End Of Report"
Do Until Len(ActiveCell.Value) < 1
Start:
If GetPrinter(ActiveCell.Value) <> "" Then
sfile = ActiveCell.Value & "_" & Range("I" & ActiveCell.Row & "").Value & "_" & Format(Now(), "MMDDYYYY_HHMM") & ".pdf"
DoCmd.OpenReport "rptAffiliatePriorityCalls", acViewDesign
With Reports("rptAffiliatePriorityCalls")
.Controls("txtPTNumber").ControlSource = "='" & Range("C" & ActiveCell.Row & "").Value & "'"
.Controls("txtPtName").ControlSource = "='" & Range("E" & ActiveCell.Row & "").Value & "'"
.Controls("txtAccession").ControlSource = "='" & Range("I" & ActiveCell.Row & "").Value & "'"
.Controls("txtOrderCode").ControlSource = "='" & Range("K" & ActiveCell.Row & "").Value & "'"
.Controls("txtTestcode").ControlSource = "='" & Range("N" & ActiveCell.Row & "").Value & "'"
.Controls("txtResult").ControlSource = "='" & Range("P" & ActiveCell.Row & "").Value & "'"
.Controls("txtResulTranslation").ControlSource = "='" & Range("R" & ActiveCell.Row & "").Value & "'"
.Controls("txtSource").ControlSource = "='" & Range("T" & ActiveCell.Row & "").Value & "'"
.Controls("txtPhysName").ControlSource = "='" & Range("F" & ActiveCell.Row & "").Value & "'"
End With
DoCmd.OutputTo acOutputReport, "rptAffiliatePriorityCalls", acFormatPDF, sDir & "\" & sfile
DoCmd.Close acReport, "rptAffiliatePriorityCalls", acSaveNo
Range("A" & ActiveCell.Row & ":T" & ActiveCell.Row & "").Interior.ColorIndex = 4
'send to printer
'Shell "RUNDLL32 PRINTUI.DLL,PrintUIEntry /y /n ""SSSLIFTBP014 on vpsxspl"""
Shell "RUNDLL32 PRINTUI.DLL,PrintUIEntry /y /n """ & sPrinter & """"
PrintAnyDocument sDir & "\" & sfile
Shell "RUNDLL32 PRINTUI.DLL,PrintUIEntry /y /n ""SSSLIFTBP014 on vpsxspl"End If
ActiveCell.Offset(1, 0).Activate
Loop
Debug.Print
Workbook.Close True
ExcelApp.Quit
'Set workbook = Nothing
'Set sheet = Nothing
'Set excelApp = Nothing
'TaskKill "EXCEL.exe"
CopyFile sAffiliatePriorityFile, Mid(sAffiliatePriorityFile, 1, InStrRev(sAffiliatePriorityFile, "\")) & "\Processed\" & _
Right(sAffiliatePriorityFile, Len(sAffiliatePriorityFile) - InStrRev(sAffiliatePriorityFile, "\"))
Kill sAffiliatePriorityFile
Exit Sub
ProcessPriorityCalls_Err:
If Err.Number = 3045 Then
GoTo Start
Else
TaskKill "EXCEL.exe"
LogError Err.Number, Err.Description, "ProcessPriorityCalls", , False
Set Workbook = Nothing
Set sheet = Nothing
Set ExcelApp = Nothing
End If
End Sub
Aussiebear
06-27-2024, 12:50 PM
In my opinion the Range("B3").Activate is not qualified and Excel doesn't know what to do. I also believe that you have an unended IF statement within your Do Loop, however I shall await the gurus to comment.
ry94080
06-27-2024, 01:07 PM
In my opinion the Range("B3").Activate is not qualified and Excel doesn't know what to do. I also believe that you have an unended IF statement within your Do Loop, however I shall await the gurus to comment.


The thing is after a fresh restart, it works just fine. Then when it tries to process the next file, it bombs out.


I must've cut that piece of code with the end if. here it is again:



Sub ProcessPriorityCalls(sAffiliatePriorityFile As String)On Error GoTo ProcessPriorityCalls_Err
Dim ExcelApp As Object
Dim Workbook As Object
Dim Worksheet As Object
Dim sDir As String
Dim sfile As String
sDir = "D:\Reports\AffiliatePriorityCalls\"
'
'' Create an instance of Excel
''Set excelApp = CreateObject("Excel.Application")
'Set ExcelApp = New Excel.Application
'ExcelApp.Visible = True
'
'' Open the workbook (replace with your actual file path)
'Set Workbook = ExcelApp.Workbooks.Open(sAffiliatePriorityFile)
'
'' Set the active sheet (you can adjust this as needed)
'Set sheet = Workbook.ActiveSheet
Set ExcelApp = CreateObject("Excel.Application")
ExcelApp.Visible = True
Set Workbook = ExcelApp.Workbooks.Open(sAffiliatePriorityFile)
Set Worksheet = Workbook.Worksheets(1)
WaitFor 100000
Range("B3").Activate
'Do Until ActiveCell.Value = "End Of Report"
Do Until Len(ActiveCell.Value) < 1
Start:
If GetPrinter(ActiveCell.Value) <> "" Then
sfile = ActiveCell.Value & "_" & Range("I" & ActiveCell.Row & "").Value & "_" & Format(Now(), "MMDDYYYY_HHMM") & ".pdf"
DoCmd.OpenReport "rptAffiliatePriorityCalls", acViewDesign
With Reports("rptAffiliatePriorityCalls")
.Controls("txtPTNumber").ControlSource = "='" & Range("C" & ActiveCell.Row & "").Value & "'"
.Controls("txtPtName").ControlSource = "='" & Range("E" & ActiveCell.Row & "").Value & "'"
.Controls("txtAccession").ControlSource = "='" & Range("I" & ActiveCell.Row & "").Value & "'"
.Controls("txtOrderCode").ControlSource = "='" & Range("K" & ActiveCell.Row & "").Value & "'"
.Controls("txtTestcode").ControlSource = "='" & Range("N" & ActiveCell.Row & "").Value & "'"
.Controls("txtResult").ControlSource = "='" & Range("P" & ActiveCell.Row & "").Value & "'"
.Controls("txtResulTranslation").ControlSource = "='" & Range("R" & ActiveCell.Row & "").Value & "'"
.Controls("txtSource").ControlSource = "='" & Range("T" & ActiveCell.Row & "").Value & "'"
.Controls("txtPhysName").ControlSource = "='" & Range("F" & ActiveCell.Row & "").Value & "'"
End With
DoCmd.OutputTo acOutputReport, "rptAffiliatePriorityCalls", acFormatPDF, sDir & "\" & sfile
DoCmd.Close acReport, "rptAffiliatePriorityCalls", acSaveNo
Range("A" & ActiveCell.Row & ":T" & ActiveCell.Row & "").Interior.ColorIndex = 4
'send to printer
'Shell "RUNDLL32 PRINTUI.DLL,PrintUIEntry /y /n ""SSSLIFTBP014 on vpsxspl"""
Shell "RUNDLL32 PRINTUI.DLL,PrintUIEntry /y /n """ & sPrinter & """"
PrintAnyDocument sDir & "\" & sfile
Shell "RUNDLL32 PRINTUI.DLL,PrintUIEntry /y /n ""SSSLIFTBP014 on vpsxspl"""
End If
ActiveCell.Offset(1, 0).Activate
Loop
Debug.Print
Workbook.Close True
ExcelApp.Quit
'Set workbook = Nothing
'Set sheet = Nothing
'Set excelApp = Nothing
'TaskKill "EXCEL.exe"
CopyFile sAffiliatePriorityFile, Mid(sAffiliatePriorityFile, 1, InStrRev(sAffiliatePriorityFile, "\")) & "\Processed\" & _
Right(sAffiliatePriorityFile, Len(sAffiliatePriorityFile) - InStrRev(sAffiliatePriorityFile, "\"))
Kill sAffiliatePriorityFile
Exit Sub
ProcessPriorityCalls_Err:
If Err.Number = 3045 Then
GoTo Start
Else
TaskKill "EXCEL.exe"
LogError Err.Number, Err.Description, "ProcessPriorityCalls", , False
Set Workbook = Nothing
Set sheet = Nothing
Set ExcelApp = Nothing
End If
End Sub
Aussiebear
06-27-2024, 01:25 PM
Its early morning here and the brain is still kicking in.

While we wait for the guru's I would like you to refer to Paul Hossler's comment in this thread http://www.vbaexpress.com/forum/showthread.php?71755-Partial-qualifying-references about at least qualifying up to the Worksheet level.

My next concern is the use of the command Debug.Print. To me this appears to be open ended. I've always seen this used as Debug.Print "something".
arnelgp
06-27-2024, 05:07 PM
you try if this will work:


Sub ProcessPriorityCalls(sAffiliatePriorityFile As String)
On Error GoTo ProcessPriorityCalls_Err
Dim ExcelApp As Object
Dim Workbook As Object
Dim Worksheet As Object
Dim sDir As String
Dim sfile As String
sDir = "D:\Reports\AffiliatePriorityCalls\"
'
'' Create an instance of Excel
''Set excelApp = CreateObject("Excel.Application")
'Set ExcelApp = New Excel.Application
'ExcelApp.Visible = True
'
'' Open the workbook (replace with your actual file path)
'Set Workbook = ExcelApp.Workbooks.Open(sAffiliatePriorityFile)
'
'' Set the active sheet (you can adjust this as needed)
'Set sheet = Workbook.ActiveSheet
Set ExcelApp = CreateObject("Excel.Application")
ExcelApp.Visible = True
Set Workbook = ExcelApp.Workbooks.Open(sAffiliatePriorityFile)
Set Worksheet = Workbook.Worksheets(1)
WaitFor 100000
Worksheet.Range("B3").Activate
'Do Until ActiveCell.Value = "End Of Report"
Do Until Len(ExcelApp.ActiveCell.Value) < 1
Start:
If GetPrinter(ActiveCell.Value) <> "" Then
sfile = ExcelApp.ActiveCell.Value & "_" & Worksheet.Range("I" & ExcelApp.ActiveCell.Row & "").Value & "_" & Format(Now(), "MMDDYYYY_HHMM") & ".pdf"
DoCmd.OpenReport "rptAffiliatePriorityCalls", acViewDesign
With Reports("rptAffiliatePriorityCalls")
.Controls("txtPTNumber").ControlSource = "='" & Worksheet.Range("C" & ExcelApp.ActiveCell.Row & "").Value & "'"
.Controls("txtPtName").ControlSource = "='" & Worksheet.Range("E" & ExcelApp.ActiveCell.Row & "").Value & "'"
.Controls("txtAccession").ControlSource = "='" & Worksheet.Range("I" & ExcelApp.ActiveCell.Row & "").Value & "'"
.Controls("txtOrderCode").ControlSource = "='" & Worksheet.Range("K" & ExcelApp.ActiveCell.Row & "").Value & "'"
.Controls("txtTestcode").ControlSource = "='" & Worksheet.Range("N" & ExcelApp.ActiveCell.Row & "").Value & "'"
.Controls("txtResult").ControlSource = "='" & Worksheet.Range("P" & ExcelApp.ActiveCell.Row & "").Value & "'"
.Controls("txtResulTranslation").ControlSource = "='" & Worksheet.Range("R" & ExcelApp.ActiveCell.Row & "").Value & "'"
.Controls("txtSource").ControlSource = "='" & Worksheet.Range("T" & ExcelApp.ActiveCell.Row & "").Value & "'"
.Controls("txtPhysName").ControlSource = "='" & Worksheet.Range("F" & ExcelApp.ActiveCell.Row & "").Value & "'"
End With
DoCmd.OutputTo acOutputReport, "rptAffiliatePriorityCalls", acFormatPDF, sDir & "\" & sfile
DoCmd.Close acReport, "rptAffiliatePriorityCalls", acSaveNo
Worksheet.Range("A" & ExcelApp.ActiveCell.Row & ":T" & ExcelApp.ActiveCell.Row & "").Interior.ColorIndex = 4
'send to printer
'Shell "RUNDLL32 PRINTUI.DLL,PrintUIEntry /y /n ""SSSLIFTBP014 on vpsxspl"""
Shell "RUNDLL32 PRINTUI.DLL,PrintUIEntry /y /n """ & sPrinter & """"
PrintAnyDocument sDir & "\" & sfile
Shell "RUNDLL32 PRINTUI.DLL,PrintUIEntry /y /n ""SSSLIFTBP014 on vpsxspl"""
End If
ExcelApp.ActiveCell.Offset(1, 0).Activate
Loop
Debug.Print
Workbook.Close True
ExcelApp.Quit
'Set workbook = Nothing
'Set sheet = Nothing
'Set excelApp = Nothing
'TaskKill "EXCEL.exe"
CopyFile sAffiliatePriorityFile, Mid(sAffiliatePriorityFile, 1, InStrRev(sAffiliatePriorityFile, "\")) & "\Processed\" & _
Right(sAffiliatePriorityFile, Len(sAffiliatePriorityFile) - InStrRev(sAffiliatePriorityFile, "\"))
Kill sAffiliatePriorityFile
Exit Sub
ProcessPriorityCalls_Err:
If Err.Number = 3045 Then
GoTo Start
Else
TaskKill "EXCEL.exe"
LogError Err.Number, Err.Description, "ProcessPriorityCalls", , False
Set Workbook = Nothing
Set sheet = Nothing
Set ExcelApp = Nothing
End If
End Sub
ry94080
07-22-2024, 09:35 AM
bump
Aussiebear
07-22-2024, 01:18 PM
Rather than bumping, did you try arnelgp's code and what were the results?