'引用--microsoft ado ext.x.x for ddl ado security
Private Sub Command0_Click() '备份
Dim cat As ADOX.Catalog
Set cat = New ADOX.Catalog
Dim PT
PT = CurrentProject.Path & "\" & Format(Now(), "YYYYMMDDHHNN") & ".accdb"
cat.Create "provider=microsoft.jet.oledb.4.0;data source=" & PT & ";"
Dim REC As ADODB.Recordset
Set REC = New ADODB.Recordset
Dim sql
sql = "SELECT MSysObjects.Name FROM MSysObjects WHERE MSysObjects.Type=1"
REC.Open sql, CurrentProject.Connection, adOpenStatic, adLockReadOnly
DoCmd.SetWarnings False
For i = 1 To REC.RecordCount
If Left(REC.Fields(0), 4) = "MSys" Then
Else
CurrentProject.Connection.Execute "SELECT * INTO " & REC.Fields(0) & " IN '" & PT & "' FROM " & REC.Fields(0)
End If
REC.MoveNext
Next i
DoCmd.SetWarnings True
End Sub
Private Sub Command1_Click() '恢复
Dim varItem As Variant
'上传时通过文件选择对话框选择文件名
With Application.FileDialog(3) 'msoFileDialogFilePicker
'允许多选以实现批量上传
.AllowMultiSelect = False
.InitialFileName = ""
.Filters.Clear
.Filters.Add "所有文件", "*.*"
If .Show Then
'循环所有选择的文件名
For Each varItem In .SelectedItems
'Debug.Print varItem
Dim REC As ADODB.Recordset
Set REC = New ADODB.Recordset
Dim sql
sql = "SELECT MSysObjects.Name FROM MSysObjects WHERE MSysObjects.Type=1"
REC.Open sql, CurrentProject.Connection, adOpenStatic, adLockReadOnly
DoCmd.SetWarnings False
For i = 1 To REC.RecordCount
If Left(REC.Fields(0), 4) = "MSys" Then
Else
CurrentProject.Connection.Execute "delete * from " & REC.Fields(0)
CurrentProject.Connection.Execute "insert INTO " & REC.Fields(0) & " SELECT * FROM " & REC.Fields(0) & " IN '" & varItem & "'"
End If
REC.MoveNext
Next i
DoCmd.SetWarnings True
Next
End If
End With
End Sub
