Сохраните копию базы данных, а затем отправьте ее по электронной почте в общий почтовый ящик

Question

У меня есть скрипт, который сохраняет резервную копию базы данных (с отметкой даты) на общем диске.

Private Sub Command0_Click()

    Dim fs As Object Dim oldPath As String, newPath As String 
    Dim CurrentDate As String

    CurrentDate = Format(Now, "MMDDYY")
    oldPath = "\\xxx\xxx Database" 'Folder file is located in 
    'newPath = "\\xxx\xxx\FINANCE\USERS\xxx\xxx Operations\xxx\xxx\" 'Folder to copy file to 
    newPath = "C:\Users\xxx\Documents\xxx\xxx" 'Folder to copy file to

    Set fs = CreateObject("Scripting.FileSystemObject") 
    fs.CopyFile oldPath & "\" & "xxx Database Update v.1.6_be.accdb", newPath & "\" _
    & "xxx Database Update v.1.6_be_" & CurrentDate & ".accdb"

    Set fs = Nothing

    MsgBox "Database Backed up", , "Backup Complete" 

End Sub

Это сработало нормально.

Однако теперь меня попросили отправить базу данных на общий адрес электронной почты.

Private Sub btnbrowse_click()

    Dim filediag As FileDialog
    Dim file As Variant

    Set filediag = FileDialog(msofiledialogfilepicker)

    filediag.allowmultiselect = False
    If filediag.show Then
        For Each file In filediag.selecteditems
        Me.txtattachment = file
        Next
    End If
End Sub

Private Sub btnSend_Click()

    Dim oApp As New Outlook.Application
    Dim oEmail As Outlook.MailItem

    Set oEmail = oApp.CreateItem(olMailItem)

    oEmail.To = Me.txtto
    oEmail.Subject = Me.txtsubject
    oEmail.Body = Me.txtbody
    If Len(Me.txtattachment) > 0 Then
        oEmail.Attachments.Add Me.txtattachment.Value
    End If
    With oEmail
        If Not IsNull(.To) And Not IsNull(.Subject) And Not IsNull(.Body) Then
            .Send
            MsgBox "Email Sent!"
        Else
            MsgBox "Please fill out the required fields."
        End If
    End With       
End Sub

Пожалуйста, кто-нибудь может помочь мне связать два сценария, чтобы вместо использования FileDialog для выбора вложения к электронной почте я мог использовать путь в первом запросе, чтобы выбрать вложение, и сценарий запустит обакоманды сохранения файла и файла электронной почты одновременно.

Answer 1

Если вы хотите просто автоматически отправлять после резервного копирования, сделайте код электронной почты Sub, который можно вызвать в процедуре нажатия кнопки Backup.

Sub SendEmail(strFile As String)
...
oEmail.Attachments.Add strFile
...
End Sub

Затем, вызывая подпункт в конце кнопки резервного копирования, нажмите:

SendEmail(newPath & "\xxx Database Update v.1.6_be_" & CurrentDate & ".accdb")

Многие системы электронной почты отклоняют электронные письма с файлом Access в качестве вложения из-за злонамеренногоКодовый риск.Тем не менее, заархивированный файл доступа должен пройти защиту.Пример кода:

Dim strZip As String
strZip = CurrentProject.Path & "\Construction.zip"
'create empty zip folder
'found this on web, no idea what the Print line does but if it isn't there, this won't work
Open strZip For Output As #1
Print #1, "PK" & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
'copy file into zip folder
Dim objApp As Object
Set objApp = CreateObject("Shell.Application")
'variable for source file doesn't seem to work in this line
'also double parens not in original example code but won't work without
objApp.NameSpace((strZip)).CopyHere CurrentProject.Path & "\Construction.accdb"

Как отмечено в комментарии к коду, проблема заключается в передаче исходного файла через переменную.Извините, мне никогда не нужно было решать.

Создание кода zip-файла можно выполнить в процедуре электронной почты, а затем прикрепить zip-файл:

oEmail.Attachments.Add strZip

Затем в конце процедуры электронной почты можно удалить zip-файл.файл:
Kill strZip

Answer 2

Это просто имя файла, поэтому оно может просто передавать значение из вашего скрипта:

oEmail.Attachments.Add newPath & "\xxx Database Update v.1.6_be_" & CurrentDate & ".accdb"