Copiar archivos seleccionados en cuadro de dialogo
Para Dante Amor
Necesitaría copiar esos mismos archivos que he seleccionado a través del cuadro de dialogo a una carpeta concreta.
1 respuesta
Respuesta de Dante Amor
1
H o l a:
Te anexo la macro actualizada
Sub EnviarCorreo()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
des = Range("A1")
Set h2 = ThisWorkbook
ruta = h2.Path & "\"
'
ruta2 = "C:\trabajo\"
Nombre = h2.Name
Sheets("hoja1").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ruta & Nombre & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
FileCopy ruta & Nombre & ".pdf", ruta2 & Nombre & ".pdf"
'
'seleccionar archivos
Set dam = CreateObject("outlook.application").createitem(0)
dam.To = ""
dam.Cc = ""
dam.Subject = ""
dam.Body = ""
dam.Attachments.Add ruta & Nombre & ".pdf"
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Seleccione uno o varios archivos"
.Filters.Clear
.Filters.Add "Todos los archivos", "*.*"
.AllowMultiSelect = True
.InitialFileName = ruta
If .Show Then
For Each ar In .SelectedItems
dam.Attachments.Add ar
diag = InStrRev(ar, "\")
archivo = Mid(ar, diag + 1)
FileCopy ar, ruta2 & archivo
Next
End If
End With
dam.display
Set dam = Nothing
'
Kill ruta & Nombre & ".pdf"
End SubCambia en la macro esta línea por la carpeta destino:
ruta2 = "C:\trabajo\"
La macro también te copia el archivo PDF a la carpeta destino, si no quieres que se copie, quita esta línea de la macro:
FileCopy ruta & Nombre & ".pdf", ruta2 & Nombre & ".pdf"
