Access vbaで固定ディレクトリに移動し、そのディレクトリ(およびサブディレクトリ)内のすべてのファイルをzipし、zipアーカイブを(通常は)新しい場所に配置するプログラムを作成しました。アーカイブ記憶域のディレクトリ。私のアクセスフロントエンドと関連するファイルのバックアップルーチンです。私は個人的な資格情報を使って毎日クライアントマシンから実行しています。今私は、より堅牢で責任があるので、私は小さなSQL Serverマシンから実行したいと思っています。私は、Accessルーチンを "呼び出す"のではなく、T-SQLですべてをやりたいと思っています。SQL ServerエージェントジョブからアーカイブするZipファイル
私はいくつかの調査をしましたが、これで私を助ける決定的なものは見つかりませんでした。誰かが私に助けをすることができますか?ここでアクセスVBAコードです:があるので、シェルから
Function Zip_All_Files_in_Folder()
Dim FileNameZip, FolderName
Dim strDate As String, TargetPath As String
Dim oApp As Object
TargetPath = "H:\xxx\secure\Construction\Access\All Database Backup\" & Format(Date, "YYYY-MMM") & "_Backup\"
If Len(Dir(TargetPath)) = 0 Then
MkDir (TargetPath)
End If
FolderName = "H:\xxx\secure\Construction\Access\CPAS\"
strDate = Format(Date, "YY-MM-DD")
FileNameZip = TargetPath & strDate & ".zip"
'Create empty Zip File
NewZip (FileNameZip)
'Copy the files to the compressed folder
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FileNameZip).CopyHere oApp.Namespace(FolderName).items
'Keep script waiting until Compressing is done
On Error Resume Next
Dim time As Integer
Do Until (oApp.Namespace(FileNameZip).items.Count = _
oApp.Namespace(FolderName).items.Count) Or time > 180
Sleep (1000)
time = time + 1
Loop
On Error GoTo 0
'Send a message about the way the script ended
If time < 180 Then
SendEmail "[email protected]", "Looks like the zip backup worked." & vbCrLf & TargetPath
Else
SendEmail "[email protected]", "Better double check the Zip backup: " & time & " seconds" & vbCrLf & TargetPath
End If
DoCmd.Quit
End Function
Sub NewZip(sPath)
'Create empty Zip File
'Changed by keepITcool Dec-12-2005
If Len(Dir(sPath)) > 0 Then Kill sPath
Open sPath For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
End Sub
SS2k5 Full、Office2007、MSServer2k8 –
OKをクリックすると、スクリプトを実行するためにSQL Serverでスケジュールされたジョブを作成することができます。また、保守計画も確認できます。しかし、最も簡単な解決策は、依然としてスタンドアロンのスクリプトです。 – Pondlife