automatisch email schicken per Excel

[ezay]

Moin zusammen,

ich habe ein Skript geschrieben, mit dem ich automatisch ein ZIP-Ordner erstelle und diesen per email verschicke. Das ganze funktioniert auch so ganz gut, außer dass mir Outlook sagt, dass die Anlage angeblich geöffnet sei. Das Fenster muss ich dann bestätigen, sodass er die email dann verschickt. Nun nervt dieses natürlich in der Automatik ein bisschen und würde das ganze gerne irgendwie beseitigen.

Den ZIP-Ordner erstelle ich mit folgendem Code:

Code:

Sub ZipFolder(folderToZipPath As Variant, zippedFileFullName As Variant)

Dim ShellApp As Object

'Create an empty zip file
Open zippedFileFullName For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1

'Copy the files & folders into the zip file
Set ShellApp = CreateObject("Shell.Application")
ShellApp.Namespace(zippedFileFullName).CopyHere ShellApp.Namespace(folderToZipPath).items

'Zipping the files may take a while, create loop to pause the macro until zipping has finished.
On Error Resume Next
Do Until ShellApp.Namespace(zippedFileFullName).items.Count = ShellApp.Namespace(folderToZipPath).items.Count
    Application.Wait (Now + TimeValue("0:00:01"))
Loop
On Error GoTo 0

End Sub

Muss ich den ZIP Ordner danach noch irgendwie manuell schließen? Kann mir da irgendjemand weiterhelfen? :)

[Mase]

Mach Ich u.a. so:

Code:

Option Explicit
Const m_zipExtension As String = "ZIP"
'Ur-Quelle: https://codekabinett.com/rdumps.php?Lang=2&targetDoc=create-zip-archive-vba-shell32
'geringfügig angepasst


Public Sub AddToZip(ByVal zipArchivePath As String, ByVal addPath As String)

    Dim sh        As New Shell32.Shell
    Dim fSource    As Shell32.Folder
    Dim fTarget    As Shell32.Folder
    Dim iSource    As Shell32.FolderItem
    Dim sourceItem As Shell32.FolderItem
    Dim i          As Shell32.FolderItem
    '
    Set fTarget = sh.Namespace((zipArchivePath))
    If fTarget Is Nothing Then
        createZipFile zipArchivePath
        Set fTarget = sh.Namespace((zipArchivePath))
    End If
    '
    Set fSource = sh.Namespace((addPath))
    With fSource
        For Each i In .Items
            If Not UCase(Right(i, 3)) = m_zipExtension Then 'ZIP
                fTarget.CopyHere i
                Application.Wait Now() + TimeSerial(0, 0, 3)
            End If
        Next i
    End With
    '
End Sub

Public Sub createZipFile(ByVal fileName As String)
   
    Dim fileNo            As Integer
    Dim ZIPFileEOCD(22)    As Byte
   
    'Signature of the EOCD:  &H06054b50
    ZIPFileEOCD(0) = Val("&H50")
    ZIPFileEOCD(1) = Val("&H4b")
    ZIPFileEOCD(2) = Val("&H05")
    ZIPFileEOCD(3) = Val("&H06")
   
    fileNo = FreeFile
    Open fileName For Binary Access Write As #fileNo
    Put #fileNo, , ZIPFileEOCD
    Close #fileNo
   
End Sub

[herbert grom]

Hallo,

da ich so etwas noch nie gemacht habe, kann ich dir nicht sagen, wie das funktioniert. Aber da man mit "Application.DisplayAlerts = False" ansonsten nervige Nachfragen unterdrücken kann, wäre es einen Versuch wert, denke ich jedenfalls.

Servus