Consulting

Results 1 to 7 of 7

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

Threaded View

Previous Post Previous Post   Next Post Next Post
  1. #1
    VBAX Regular
    Joined
    Jul 2016
    Posts
    25
    Location

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

    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
    Last edited by Aussiebear; 06-27-2024 at 12:46 PM. Reason: Corrected the layout

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •