New to Excel VBA - Need a bit of help

[jgelpi16]

I am exporting a table from Access into Excel. After the table is exported I am performing a bunch of formatting to the sheet. Below is my code that I took from a Macro in the Excel Spreadsheet. I have highlighted the bit that is giving me a problem. I keep getting the run-time error:



"Run-time error '462': The remote server machine does not exist or is unavailable"

Any explanation/help will be much appreciated.

Function funFormatExcel(sFile As String)
    Dim xlApp As Object
    Dim xlSheet As Object
    Dim c As Range, lr As Long
'    Dim sFile As String
    
'    sFile = "C:\Documents and Settings\jgelpi\Desktop\tblDMContact.xls"
'    On Error GoTo Err_ModifyExportedExcelFileFormats

    Application.SetOption "Show Status Bar", True
    vStatusBar = SysCmd(acSysCmdSetStatus, "Formatting export file... please wait.")
    
    Set xlApp = CreateObject("Excel.Application")
    Set xlSheet = xlApp.Workbooks.Open(sFile).Sheets(1)
    
    xlApp.Rows("1:1").Select
    With xlApp.Application
        .Selection.Font.Bold = True
        .Sheets("RVPs_by_DIV").Select
        .Rows("1:1").Select
        .Selection.Font.Bold = True
        .Columns("A:A").Select
        .Selection.Delete Shift:=xlToLeft
        .Sheets("DMsAOMsETC").Select
        .Columns("A:A").Select
        .Selection.Delete Shift:=xlToLeft
        .Cells.Select
        .Selection.AutoFilter
        .Sheets("RVPs_by_DIV").Select
        .Cells.Select
        .Selection.AutoFilter
        .Range("A1").Select
        .Sheets("DMsAOMsETC").Select
        .Range("C1").Select
        .ActiveCell.FormulaR1C1 = "Last Name"
        .Range("D1").Select
        .ActiveCell.FormulaR1C1 = "First Name"
        .Range("E1").Select
        .ActiveCell.FormulaR1C1 = "Base Store"
        .Range("F1").Select
        .ActiveCell.FormulaR1C1 = "Cell Number"
        .Range("G1").Select
        .ActiveCell.FormulaR1C1 = "Job Title"
        .Range("J1").Select
        .ActiveCell.FormulaR1C1 = "Vice President"
        .Range("J2").Select
        .Sheets("RVPs_by_DIV").Select
        .ActiveCell.FormulaR1C1 = "Division"
        .Range("B1").Select
        .ActiveCell.FormulaR1C1 = "Region"
        .Range("C1").Select
        .ActiveCell.FormulaR1C1 = "Base Store"
        .Range("D1").Select
        .ActiveCell.FormulaR1C1 = "First Name"
        .Range("E1").Select
        .ActiveCell.FormulaR1C1 = "Last Name"
        .Range("G1").Select
        .ActiveCell.FormulaR1C1 = "Address 1"
        .Range("H1").Select
        .ActiveCell.FormulaR1C1 = "Address 2"
        .Range("I1").Select
        .ActiveCell.FormulaR1C1 = "City"
        .Range("J1").Select
        .ActiveCell.FormulaR1C1 = "State"
        .Range("K1").Select
        .ActiveCell.FormulaR1C1 = "Zip"
        .Range("L1").Select
        .ActiveCell.FormulaR1C1 = "Cell Number"
        .Range("N1").Select
        .ActiveCell.FormulaR1C1 = "Internal Extension 1"
        .Range("O1").Select
        .ActiveCell.FormulaR1C1 = "Internal Extension 2"
        .Range("P1").Select
        .ActiveCell.FormulaR1C1 = "Office Number 1"
        .Range("Q1").Select
        .ActiveCell.FormulaR1C1 = "Office Number 2"
        .Range("R1").Select
        .ActiveCell.FormulaR1C1 = "Toll-Free Number"
        .Range("S1").Select
'    ActiveWindow.ScrollColumn = 4
'    ActiveWindow.ScrollColumn = 3
'    ActiveWindow.ScrollColumn = 2
'    ActiveWindow.ScrollColumn = 1
    End With
    ActiveWorkbook.Worksheets("RVPs_by_DIV").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("RVPs_by_DIV").AutoFilter.Sort.SortFields.Add Key:= _
        Range("B1:B43"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("RVPs_by_DIV").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Worksheets("RVPs_by_DIV").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("RVPs_by_DIV").AutoFilter.Sort.SortFields.Add Key:= _
        Range("A1:A43"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("RVPs_by_DIV").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Rows("2:2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
    Range("3:4,13:13,21:21,30:30,40:40").Select
    Range("A40").Activate
    ActiveWindow.SmallScroll Down:=-3
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent5
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
    Range("5:5,14:14,22:22,31:31,41:41").Select
    Range("A41").Activate
    ActiveWindow.SmallScroll Down:=0
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A1").Select
    Sheets("DMsAOMsETC").Select
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A1").Select
    Sheets("RVPs_by_DIV").Select
    Range("2:5,13:14,21:22,30:31,40:41").Select
    Range("A40").Activate
    ActiveWindow.SmallScroll Down:=-18
    Selection.Font.Bold = True
    Cells.Select
    Cells.EntireColumn.AutoFit
    Sheets("DMsAOMsETC").Select
    Range("A1").Select
    
    xlApp.Application.ActiveWorkbook.Save
    xlApp.Application.ActiveWorkbook.Close
    xlApp.Quit
    
    Set xlApp = Nothing
    Set xlSheet = Nothing
End Function

[jgelpi16]

I'm not sure if this is the correct solution, but I added a check for of Excel was open or not. Haven't ran into the error yet...

Function IsExcelRunning() As Boolean
    Dim xlApp As Excel.Application
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    IsExcelRunning = (Err.Number = 0)
    Set xlApp = Nothing
    Err.Clear
End Function

    Dim ExcelRunning As Boolean
    ExcelRunning = IsExcelRunning()
    
    If ExcelRunning Then
        Set xlApp = GetObject(, "Excel.Application")
    Else
        Set xlApp = CreateObject("Excel.Application")
    End If