Ich hab mir ein Marko zusammengebastelt, welches eine im Anhang einer Email gesendeten Zip Datei öffnet - dort befindet sich eine pdf Datei, die entpackt werden soll... doch die ZIP Datei ist Passwortgeschützt. Glücklicherweise ist das Passwort immer das gleiche...Das alles funktioniert mit noch 2 Nebenfunktionen sehr gut... bis das Passwort abgefragt wird... die bekomme ich nicht eingetragen/übergeben...... wie bekomme ich das hin? Kann mir jemand helfen.
CodeTags korrigiert ~VaporiZed
Visual Basic-Quellcode
- Public Sub Entpacken()
- Dim objOL As Outlook.Application
- Dim objMsg As Outlook.MailItem
- Dim objAttachments As Outlook.Attachments
- Dim objSelection As Outlook.Selection
- Dim i As Long
- Dim lngCount As Long
- Dim strFile As String
- Dim strFolderpath As String
- Set objOL = CreateObject("Outlook.Application")
- Set objSelection = objOL.ActiveExplorer.Selection
- strFolderpath = "F:\Alarmemail\Zip-Datei\"
- For Each objMsg In objSelection
- Set objAttachments = objMsg.Attachments
- lngCount = objAttachments.Count
- If lngCount > 0 Then
- For i = lngCount To 1 Step -1
- strFile = objAttachments.Item(i).FileName
- strFile = strFolderpath & strFile
- objAttachments.Item(i).SaveAsFile strFile
- Call UnZipMe
- Next
- End If
- Next
- ExitSub:
- Set objAttachments = Nothing
- Set objMsg = Nothing
- Set objSelection = Nothing
- Set objOL = Nothing
- End Sub
- Sub UnZipMe()
- Dim str_FILENAME As String, str_DIRECTORY As String, str_DESTINATION As String
- str_DIRECTORY = "F:\Alarmemail\Zip-Datei\"
- str_FILENAME = Dir(str_DIRECTORY & "*.zip")
- Do While Len(str_FILENAME) > 0
- Call Unzip1(str_DIRECTORY & str_FILENAME)
- Debug.Print str_FILENAME
- str_FILENAME = Dir
- Loop
- End Sub
- Sub Unzip1(str_FILENAME As String)
- Dim oApp As Object
- Dim Fname As Variant
- Dim FnameTrunc As Variant
- Dim FnameLength As Long
- Fname = str_FILENAME
- FnameLength = Len(Fname)
- FnameTrunc = Left(Fname, FnameLength - 4) & "\"
- If Fname = False Then
- Else
- FnameTrunc = "F:\Alarmemail\Einsatz\"
- Set oApp = CreateObject("Shell.Application")
- oApp.NameSpace(FnameTrunc).CopyHere oApp.NameSpace(Fname).Items
- End If
- End Sub
CodeTags korrigiert ~VaporiZed
