Hola experto! Tengo un ligerito problema..tengo el siguiente programa: Public Sub test() 'Arg 1 = subfolder name in your Inbox 'Arg 2 = File extension, "jpg" is every file 'Arg 3 = Save folder, "C:\REPORTES-LCD" or "" SaveEmailAttachmentsToFolder "Myfolder", "jpg", "C:\REPORTES-LCD" End Sub cuando lo corro me sale un mensaje de error "type mismatch" y me sombrea "Myfolder" y no sé porqué ni cómo solucionarle...me ayudas con eso porfas?
gracias!
Podrias explicar un poco mas que estas haciendo, y el error es que myfolder no es un tipo de datos aceptado por lo que estas tratando de utilizar
Quiero que si me llega un correo con adjunto jpg a la subcarpeta myfolder en outlook, lo pase a una carpeta en la unidad C. El programa es algo largo pero es este... Public Sub test() 'Arg 1 = subfolder name in your Inbox 'Arg 2 = File extension, "jpg" is every file 'Arg 3 = Save folder, "C:\REPORTES-LCD" or "" SaveEmailAttachmentsToFolder "Myfolder", "jpg", "C:\REPORTES-LCD" End Sub Public Sub SaveEmailAttachmentsToFolder(Item As MailItem, ExtString As String, DestFolder As String) On Error GoTo ThisMacro_err 'Do not change code in the macro below Dim ns As NameSpace Dim Inbox As MAPIFolder Dim subfolder As MAPIFolder Dim Item As Object Dim Atmt As Attachment Dim FileName As String Dim MyDocPath As String Dim I As Integer Dim wsh As Object Dim fs As Object Set ns = GetNamespace("MAPI") Set Inbox = ns.GetDefaultFolder(olFolderInbox) Set subfolder = Inbox.Folders(OutlookFolderInInbox) I = 0 'Check subfolder for messages and exit of none found If subfolder.Items.Count = 0 Then MsgBox "There are no messages in this folder : " & OutlookFolderInInbox, vbInformation, "Nothing Found" Set subfolder = Nothing Set Inbox = Nothing Set ns = Nothing Exit Sub End If 'Create DestFolder if DestFolder = "" If DestFolder = "" Then Set wsh = CreateObject("WScript.Shell") Set fs = CreateObject("Scripting.FileSystemObject") MyDocPath = wsh.SpecialFolders.Item("c:\REPORTES-LCD") DestFolder = MyDocPath & "\" & Format(Now, "mmm-dd-yyyy hh-mm-ss") If Not fs.FolderExists(DestFolder) Then fs.CreateFolder DestFolder End If End If If Right(DestFolder, 1) <> "\" Then DestFolder = DestFolder & "\" End If ' Check each message for attachments and extensions For Each Item In subfolder.Items For Each Atmt In Item.Attachments If LCase(Right(Atmt.FileName, Len(ExtString))) = LCase(ExtString) Then FileName = DestFolder & Item.SenderName & " " & Atmt.FileName Atmt.SaveAsFile FileName I = I + 1 End If Next Atmt Next Item ' Show this message when Finished If I > 0 Then MsgBox "You can find the files here : " _ & DestFolder, vbInformation, "Finished!" Else MsgBox "No attached files in your mail.", vbInformation, "Finished!" End If ' Clear memory ThisMacro_exit: Set subfolder = Nothing Set Inbox = Nothing Set ns = Nothing Set fs = Nothing Set wsh = Nothing Exit Sub ' Error information ThisMacro_err: MsgBox "An unexpected error has occurred." _ & vbCrLf & "Please note and report the following information." _ & vbCrLf & "Macro Name: SaveEmailAttachmentsToFolder" _ & vbCrLf & "Error Number: " & Err.Number _ & vbCrLf & "Error Description: " & Err.Description, vbCritical, "Error!" Resume ThisMacro_exit End Sub
Encontre este codigo que supuestamente lo hace ' Demonstrates how to save email attachments to a directory Private Sub Save_Email_Attachments(dirPath As String, email As ChilkatEmail2) ' We can easily save all the attachments to the specified directory ' by calling SaveAllAttachments. ' The SaveAllAttachments method will automatically create the directory ' if it does not already exist. success = email.SaveAllAttachments(dirPath) ' the return value is 1 for success, 0 for failure. A failure typically ' would occur if the process did not have permission to create files ' in the directory. If (success = 0) Then ' The last-error information should contain enough information for you ' to resolve the problem. MsgBox email.LastErrorText Exit Sub End If ' The email.OverwriteExisting property controls whether already-existing files ' are automatically overwritten. By default, it is set to 1 so that existing ' files will be overwritten. ' Setting OverwriteExisting = 0 will cause the attachment-saving methods to generate ' unique filenames if a file with the same name already exists. The actual filename(s) ' saved will be present by calling GetAttachmentFilename for each attachment *after* ' saving. ' For example... email.OverwriteExisting = 0 success = email.SaveAllAttachments(dirPath) n = email.NumAttachments For i = 0 To n - 1 ' If the attachment filename was changed to prevent overwriting, ' GetAttachmentFilename will return the new filename. List1.AddItem email.GetAttachmentFilename(i) Next ' You may also save individual attachments: For i = 0 To n - 1 List1.AddItem "Original Filename: " & email.GetAttachmentFilename(i) success = email.SaveAttachedFile(i, dirPath) List1.AddItem "Saved Filename: " & email.GetAttachmentFilename(i) Next End Sub Fijate si te sirve