同一Access数据库在另一台计算机上产生错误

Question

我有一个生成Excel扩展名的子例程。我在家中有Access 2016，在工作中我们也使用2016。

以下是参考文献

它在工作中工作正常，但是当我尝试在家里运行该程序时，出现错误1004，它在此行停止：

.Papersize = xlPaperLetter

这是完整的代码：

Private Sub Generate_FS(Optional dbFullPath As String)


Dim xlApp As Excel.Application
Dim WB As Excel.Workbook
Dim xlSheet As Excel.Worksheet

Dim db As DAO.Database

Dim rs As DAO.Recordset
Dim rsCategories As DAO.Recordset

Dim xlCellAddr As Range

Dim i, M, n As Integer
Dim iCategory_rec_count As Integer

Dim iInsert_row_count As Integer
Dim iCols(1 To 10) As Integer

Dim strFileName As String
Dim strLocation As String
Dim strXLStartCell As String
Dim strCat As String


Dim strSheet As String
Dim iBottom As Integer

iBottom = 0

strSheet = "FINANCIAL STATUS"

Set xlApp = CreateObject("Excel.Application")
Set WB = xlApp.Workbooks.Add
Set xlSheet = WB.Sheets("Sheet1")


If Len(dbFullPath) < 1 Then
    Set db = CurrentDb
Else
    Set db = OpenDatabase(dbFullPath, True)
End If



xlApp.Visible = False



SyncActiveFile
Form_sfAFvsSTACY.Requery

Call CreateFSTemplate(WB, "Sheet1")



If Me.lblWhere.Caption = "" Then
    Set rsCategories = db.OpenRecordset("SELECT * FROM tbl_Budget_Authorization ORDER BY SORT")
Else
    Set rsCategories = db.OpenRecordset("SELECT * FROM tbl_Budget_Authorization WHERE BA_Category " & Me.lblWhere.Caption & " ORDER BY SORT")
End If

Debug.Print "SELECT * FROM tbl_Budget_Authorization WHERE BA_Category " & Me.lblWhere.Caption & " ORDER BY SORT"


If Not (rsCategories.EOF And rsCategories.BOF) Then

rsCategories.MoveFirst



    For n = 1 To DCount("BA_Category", "tbl_Budget_Authorization", "BA_CATEGORY " & Me.lblWhere.Caption) ', "FY='" & cboFY & "'") 'rsCategories.RecordCount






        strCat = rsCategories!BA_Category

        Set rs = GetFSSection(strCat)





        iCategory_rec_count = Val(Nz(DLookup("CAT_COUNT", "qFS_Category_Count", "Category='" & rsCategories!BA_Category & "'"), 0))
        iInsert_row_count = iCategory_rec_count - 1

        Set xlCellAddr = xlSheet.Range("D1:D5000").Find("TOTAL " & rsCategories![BA_Category], lookat:=xlPart)


        If iInsert_row_count > 0 Then

            For i = 1 To iInsert_row_count

               xlSheet.Rows(xlCellAddr.Row).Insert Shift:=xlDown

            Next
        End If



          Set xlCellAddr = xlSheet.Range("D2:D5000").Find("TOTAL " & rsCategories![BA_Category], lookat:=xlPart)



          strXLStartCell = "B" & (xlCellAddr.Row - iCategory_rec_count)

        'Copy the recordset
        xlSheet.Range(strXLStartCell).CopyFromRecordset rs

        rsCategories.MoveNext



    Next


       iBottom = xlCellAddr.Row


End If


'Format
xlSheet.Columns("A:A").NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
xlSheet.Columns("E:I").NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"


'perform running balance separately and obtain 'available balance'
Call CreateRunningBalance(WB, strSheet, iBottom)

    'Make working section into a table
    With xlSheet

        .ListObjects.Add(xlSrcRange, .Range("B2:I" & iBottom), , xlYes).Name = "Table1"
        .ListObjects("Table1").TableStyle = "TableStyleMedium12"
    End With



With xlSheet
    .Columns("A:A").EntireColumn.AutoFit
    .Columns("B:B").EntireColumn.AutoFit
    .Columns("C:C").EntireColumn.AutoFit
    .Columns("I:I").EntireColumn.AutoFit
End With


'**ADD Budget Authorization Total and Available Balance
Dim cBA_Total As Currency
Dim cAvailBalance As Currency

cBA_Total = Nz(DSum("Budget_Authorization", "tbl_Budget_Authorization", "FY='" & cboFY & "'"), 0)

xlSheet.Range("A" & iBottom + 1).FormulaR1C1 = "Budget Authorization: " & Format(cBA_Total, "Currency")
'Available balance gets written from CreateRunningBalance

With xlSheet.Range("A" & iBottom + 1 & ":I" & iBottom + 2).Interior
                .Pattern = xlSolid
                '.Color = RGB(177, 160, 199) 'light purple
                .Color = RGB(79, 0, 158) ' dark purple
            End With


            With xlSheet.Range("A" & iBottom + 1 & ":I" & iBottom + 2).Font
                .Name = "Arial Black"
                .Size = 11
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = 0
                .Bold = True
            End With





xlSheet.Range("D1").FormulaR1C1 = "J02HQ2 FINANCIAL STATUS AS OF " & Now()

'Format the header like the CATEGORY rows

            With xlSheet.Range("A1:I1").Interior
                .Pattern = xlSolid
                .Color = RGB(79, 0, 158)
            End With

             With xlSheet.Range("A1:I1").Font
                .Name = "Arial Black"
                .Size = 14
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = 0
                .Bold = True
            End With



            With xlSheet.Range("A2:I2").Font
                .Name = "Arial Black"
                .Size = 11
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = 0
                .Bold = True
            End With






xlSheet.Range("A6").Select


WB.RefreshAll


strFileName = "J02HQ2 FINANCIAL_STATUS_" & DateString & ".xlsx"

    strLocation = Environ("userprofile") & "\Documents\Financial Status\"

    ensurePath strLocation


'======================================
    With xlSheet.PageSetup

        .PrintTitleRows = "$1:$2" 'This property sets the first 2 rows to repeat on every page

        .Zoom = False

        .FitToPagesWide = 1
        .FitToPagesTall = False

        .Order = xlDownThenOver
        .Orientation = xlLandscape
        .PaperSize = xlPaperLetter

        .PrintQuality = 600
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .CenterHorizontally = False
        .CenterVertically = False
        .Draft = False
        .FirstPageNumber = xlAutomatic
        .BlackAndWhite = False
        .PrintErrors = xlPrintErrorsDisplayed



        .LeftMargin = xlApp.InchesToPoints(0.25)
        .RightMargin = xlApp.InchesToPoints(0.25)
        .TopMargin = xlApp.InchesToPoints(0.25)

       .BottomMargin = .Application.InchesToPoints(0.5)
       .FooterMargin = .Application.InchesToPoints(0.3)
       .CenterFooter = "Page &P"



        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True

    End With


'======================================


   'For Row 2
    With xlSheet.Range("A2:I2").Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 13855654
    End With


    With WB
        .TableStyles("TableStyleMedium6").Duplicate ("ToPurple")
        .TableStyles("ToPurple").TableStyleElements(xlWholeTable).Clear

    End With

    With WB.TableStyles("ToPurple").TableStyleElements(xlWholeTable).Interior
        .PatternColor = RGB(207, 175, 231) 'lighter purple
        .Color = RGB(166, 107, 211) 'darker purple
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

    WB.TableStyles("ToPurple").TableStyleElements(xlRowStripe1).Clear

    With WB.TableStyles("ToPurple").TableStyleElements(xlRowStripe1).Interior
        .Color = RGB(207, 175, 231) 'lighter purple
        .TintAndShade = 0
    End With

    xlSheet.ListObjects("Table1").TableStyle = "ToPurple"


'======================================================================


Debug.Print strLocation & strFileName

WB.SaveAs FileName:=strLocation & strFileName


'Cleanup

Set xlSheet = Nothing
For Each WB In xlApp.Workbooks
    WB.Close False
Next

xlApp.Quit
PresentExcel (strLocation & strFileName)


GoTo Exit_Hand



Exit_Hand:
Set xlSheet = Nothing


Set rs = Nothing
Set rsCategories = Nothing

Set xlCellAddr = Nothing


Set db = Nothing
Set WB = Nothing
Set xlApp = Nothing




End Sub 

Answer 1

更改

 .Order = xlDownThenOver
 .Orientation = xlLandscape
 .PaperSize = xlPaperLetter

到，因为MS访问无法识别这些枚举

  .Order = 1
  .Orientation = 2
  .PaperSize = 1

See this for quick reference of excel constants

Answer 2

发布尽可能多的代码很重要。像@Santosh这样的人可能会找到答案，在这种情况下，他认识到Excel对象对我的打印机有问题。这就是为什么它在工作中而不是在家工作的原因。