以下代码适用于一台计算机,但不适用于另一台计算机。我检查了所有参考文献,它们在两台计算机上都是相同的。我跟踪了代码,在它不起作用的计算机上,我没有收到错误消息,但 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
谢谢,
拍