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

Originally Posted by Aussiebear

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/show...ing-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?

Thread: Bug in my code that opens up Excel files from Access to edit.

Thread Tools

Display

Bug in my code that opens up Excel files from Access to edit.

Posting Permissions