Hi again,
I expandet my code as follow (save the attached files from Outlook - after: If Not Err.Number <> 0 Then):
Code:
Option Compare
DatabaseOption Explicit
Private Sub Befehl17_Click()
' ##################### OutlookImport ##################################
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim outObject, Mapi, Inbox, InboxImported
Dim i As Integer
Dim strSQL As String
Set rs = CurrentDb.OpenRecordset("OutlookImport")
Set outObject = CreateObject("Outlook.Application")
Set Mapi = outObject.GetNamespace("MAPI")
Set Inbox = Mapi.GetDefaultFolder(olFolderInbox).Folders("import")
Set InboxImported = Mapi.GetDefaultFolder(olFolderInbox).Folders("imported")
For Each Mail In Inbox.Items
strSQL = "INSERT INTO OutlookImport (AbsenderMail, AbsenderName, SendTo, SendCC, Betreff, MailDatum, Nachricht, EntryID) VALUES ('" & Mail.SenderEmailAddress & "', '" & Mail.SenderName & "', '" & Mail.To & "', '" & Mail.CC & "', '" & Mail.Subject & "', '" & Mail.SentOn & "', '" & Mail.Body & "', '" & Mail.EntryID & "');"
DoCmd.SetWarnings False
On Error Resume Next
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
If Not Err.Number <> 0 Then
If Mail.Attachments.Count > 0 Then
AnzAttach = Mail.Attachments.Count
strPath = "C:\Unterlagen\" & Replace(Mail.SenderName, " ", "") & "_" & Replace(Replace(Mail.SentOn, " ", "_"), ":", ".")
Debug.Print strPath
MkDir strPath
For i = 1 To AnzAttach
Mail.Attachments.Item(i).SaveAs strPath & Mail.Attachments.Item(i).FileName
Next i
Mail.Move InboxInBearbeitung 'Mails verschieben in Bearbeitung
End If
End If
Next
Forms![OutlookImport].Requery
End Sub
the directroy "Unterlagen" allready exist.
So, the definition of the path works (strPath)
the creation of the path wirks (MkDir)
but the SaveAs command did not work, the new directories are empty.
I think, the syntax is correctly, isīnt it?
any ideas?
thx