为什么 CurrentDB 可以在一台计算机上运行,​​而不能在另一台计算机上运行

时间:2021-07-13 15:00:15

标签: vba ms-access

以下代码适用于一台计算机,但不适用于另一台计算机。我检查了所有参考文献,它们在两台计算机上都是相同的。我跟踪了代码,在它不起作用的计算机上,我没有收到错误消息,但 TDF 行中的所有内容都是空白的:For Each TDF In .CurrentDb.TableDefs。这是什么原因?有什么线索吗?

Public Sub btnBuildDatabase(ByVal control As IRibbonControl)
Dim oAccess As Access.Application
Dim sPath As String
Dim TDF As TableDef
Dim mePath As String
On Error Resume Next

If MsgBox("Are you sure you want to build the database?" & vbCrLf & " This will delete all data!", vbYesNo, "Build Database") = vbYes Then
SysCmd acSysCmdInitMeter, "Initializing Database for Build...", 20
SysCmd acSysCmdUpdateMeter, 1

mePath = CurrentProject.Path & "\" & CurrentProject.Name
sPath = selectFile("*.accdb")
DoCmd.SetWarnings False
If TableExistsCurrentDB("ShipLogo") Then
    DoCmd.DeleteObject acTable, "ShipLogo"
End If
Set oAccess = New Access.Application
With oAccess
SysCmd acSysCmdInitMeter, "Transferring Data...", 20
SysCmd acSysCmdUpdateMeter, 2
    .OpenCurrentDatabase sPath, False
    For Each TDF In .CurrentDb.TableDefs
        If TDF.Attributes = 0 Then
            If TDF.Name = "ShipLogo" Then
                .DoCmd.TransferDatabase acExport, "Microsoft Access", mePath, acTable, TDF.Name, TDF.Name, False
            Else
                .DoCmd.TransferDatabase acExport, "Microsoft Access", mePath, acTable, TDF.Name, TDF.Name & "TempImport", False
            End If
        End If
    Next
    .CloseCurrentDatabase
    .Quit
End With
Set oAccess = Nothing
SysCmd acSysCmdUpdateMeter, 3
    Application.AutomationSecurity = msoAutomationSecurityForceDisable
    DoCmd.SetWarnings False
    DoCmd.RunSQL "DELETE * FROM EOV_COMMENTS;"
    DoCmd.RunSQL "DELETE * FROM EOV_Conflicts;"
    DoCmd.RunSQL "DELETE * FROM importTSRASub;"
    DoCmd.RunSQL "DELETE * FROM MAT;"
    DoCmd.RunSQL "DELETE * FROM TBL_ShipContact;"
    DoCmd.RunSQL "DELETE * FROM tblESWBS_List;"
    DoCmd.RunSQL "DELETE * FROM tblICMP_Submarines;"
    DoCmd.RunSQL "DELETE * FROM tblLevel2;"
    DoCmd.RunSQL "DELETE * FROM tblMARMC_USERS_BranchHead;"
    DoCmd.RunSQL "DELETE * FROM tblMM001_Grid_SourceObject;"
    DoCmd.RunSQL "DELETE * FROM tblPartsAdminEditor;"
    DoCmd.RunSQL "DELETE * FROM tblTeamMember;"
    DoCmd.RunSQL "DELETE * FROM Training;"
    DoCmd.RunSQL "DELETE * FROM TWOK;"
    DoCmd.RunSQL "DELETE * FROM TwoKiloChangeStatus;"
    DoCmd.RunSQL "DELETE * FROM MATERIALS;"
    DoCmd.RunSQL "DELETE * FROM TECH_ASSIST_CK_INPUT"
    DoCmd.RunSQL "DELETE * FROM FLC_TECH_ASSIST_CK_IMPORT"
    
    DoCmd.RunSQL "DELETE * FROM Manuals;"
    DoCmd.RunSQL UpdateManuals
    
    DoCmd.RunSQL "DELETE * FROM MSYS_tblShipInfo;"
    DoCmd.RunSQL UpdateMSYS_tblShipInfoFromNew
    
    DoCmd.RunSQL "DELETE * FROM tblAPL_Parts_Cost;"
    DoCmd.RunSQL UpdatetblAPL_Parts_CostFrom_tblAPL
    
    DoCmd.RunSQL "DELETE * FROM tblConfiguration;"
    DoCmd.RunSQL UpdatetblConfiguration
    
    DoCmd.RunSQL "DELETE * FROM ClassConfiguration1;"
    DoCmd.RunSQL UpdatetClassConfiguration
    
    DoCmd.RunSQL "DELETE * FROM tblCSMP;"
    DoCmd.RunSQL UpdatetblCSMP
    
    DoCmd.RunSQL "DELETE * FROM tblICMP;"
    DoCmd.RunSQL UpdatetblICMP
    
    DoCmd.RunSQL "DELETE * FROM WORK_NOTIFICATIONS;"
    DoCmd.RunSQL UpdateWORK_NOTIFICATIONS
    
    DoCmd.RunSQL "DELETE * FROM tblTAAS_Job_List;"
    DoCmd.RunSQL UpdatetblTAAS_Job_List
    
    DoCmd.RunSQL "DELETE * FROM [RPT TITLES];"
    DoCmd.RunSQL UpdateRPT_TITLES
    
    DoCmd.RunSQL "DELETE * FROM NEW_2KILO;"
     
SysCmd acSysCmdUpdateMeter, 4

    For Each TDF In CurrentDb.TableDefs
        If Right(TDF.Name, 10) = "TempImport" Then
            DoCmd.DeleteObject acTable, TDF.Name
        End If
    Next
SysCmd acSysCmdUpdateMeter, 5

CurrentDb.Execute "ALTER TABLE NEW_2KILO ALTER COLUMN MAF_ID COUNTER(1,1)"
SysCmd acSysCmdUpdateMeter, 6
    CurrentDb.Execute "ALTER TABLE MATERIALS ALTER COLUMN RecordID COUNTER(1,1)"
SysCmd acSysCmdUpdateMeter, 7

    DoCmd.RunSQL "delete * from TwoKiloChangeStatus"
    CurrentDb.Execute "ALTER TABLE TwoKiloChangeStatus ALTER COLUMN MAF_ID COUNTER(1,1)"

SysCmd acSysCmdUpdateMeter, 7

    DoCmd.RunSQL "delete * from training"
    CurrentDb.Execute "ALTER TABLE TRAINING ALTER COLUMN ID COUNTER(1,1)"

SysCmd acSysCmdUpdateMeter, 9

    DoCmd.RunSQL "delete * from tblTeamMember"
    CurrentDb.Execute "ALTER TABLE tblTeamMember ALTER COLUMN ID COUNTER(1,1)"

SysCmd acSysCmdUpdateMeter, 10

    DoCmd.RunSQL "UPDATE tblVisit_Personnel SET tblVisit_Personnel.LastName = '', tblVisit_Personnel.Rate = '';"
SysCmd acSysCmdUpdateMeter, 11
    CheckShipActivity
    CheckICMPTable
    UpdateICMP_POCs_on_Import
    ClearTechAssist
    WaitTime 2
    BuildInitialTeamMemberList
    DoCmd.SetWarnings False
    Application.AutomationSecurity = msoAutomationSecurityForceDisable
    
    DoCmd.RunSQL "DELETE * FROM EOV_CONFLICTS;"
    DoCmd.RunSQL "DELETE * FROM EOV_COMMENTS;"

    Application.AutomationSecurity = msoAutomationSecurityByUI
    DoCmd.SetWarnings True

SysCmd acSysCmdUpdateMeter, 12
    DoCmd.SetWarnings True
    Application.AutomationSecurity = msoAutomationSecurityByUI
    MsgBox "BUILD OF NEW DDT IS COMPLETE!" & vbCrLf & vbCrLf & "THIS DDT WILL NOW CLOSE FOR CHANGES TO TAKE EFFECT." & vbCrLf & vbCrLf & "YOU MAY RESTART IMMEDIATELY.", vbOKOnly, "BUILD COMPLETE"
    Application.Quit
SysCmd acSysCmdRemoveMeter
Exit Sub
End If
MsgBox "BUILD CANCELLED!", vbOKOnly, "BUILD DATABASE"
End Sub

谢谢,

0 个答案:

没有答案
相关问题