Envío de correo

hola, Paco !

... Me enviaron a un enlace donde consegui este codigo: [...]
Tenemos:
A1=nombre - B1= email - C1= ruta fichero adjunto
A2=nombre - B2= email - C2= ruta fichero adjunto
A3=nombre - B3= email - C3= ruta fichero adjunto
Funciona bien en parte, ya que solo envía el fichero adjunto indicado en la ruta de C1.
Evidentemente, en C2 y C3, tambien hay ruta y fichero para enviar...

1) [aparentemente]... 'el codigo' esta evaluando [como] que NO 'se cumple/n' alguna/s de las siguientes condiciones...
a) que las celdas de la columna 'B' contengan el caracter '@'
b) que el 'contenido' de la celda 'C' pueda ser evaluado como un nombre [y ruta ?] de archivo 'existente' -?-

2) prueba con una macro +/- como la siguiente -> seleccionando cada celda 'brincada' de la columna 'C'...
Sub Verifica_existencia_del_archivo()
Dim Celda As Range
For Each Celda In Selection
If Celda <> "" Then _
MsgBox "El archivo indicado en " & Celda.Address & vbCr & _
IIf(Dir(Celda) <> "", "SI", "=> NO") & " es un archivo existente !!!" & vbCr & Celda
Next
End Sub

si cualquier duda [o informacion adicional]... comentas ?
saludos,
hector.

__ el codigo expuesto __
Private Sub CommandButton1_Click()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim cell As Range, FileCell As Range
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Sheets("Hoja1").Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And Application.WorksheetFunction.CountA( _
Sheets("Hoja1").Cells(cell.Row, 1).Range("C1:F1")) > 0 Then
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = cell.Value
.Subject = "Testfile"
.Body = "Hi " & cell.Offset(0, -1).Value
'Enter the file names in the C:F column in each row
'You can make the range bigger if you want, only change the column not the 1
For Each FileCell In Sheets("Hoja1").Cells(cell.Row, 1).Range("C1:F1") _
.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell
.Display 'Or use Send
End With
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub

Hola Héctor, buenos días desde este lado.

Como siempre tienes razón: la ruta estaba mal, ¡había un espacio
antes del punto separador de la extensión!

Gracias y un afectuoso saludo.

Paco.


Héctor Miguel ha escrito:

hola, Paco !

> ... Me enviaron a un enlace donde consegui este codigo: [...]
> Tenemos:
> A1=nombre - B1= email - C1= ruta fichero adjunto
> A2=nombre - B2= email - C2= ruta fichero adjunto
> A3=nombre - B3= email - C3= ruta fichero adjunto
> Funciona bien en parte, ya que solo envía el fichero adjunto indicado en la ruta de C1.
> Evidentemente, en C2 y C3, tambien hay ruta y fichero para enviar...

1) [aparentemente]... 'el codigo' esta evaluando [como] que NO 'se cumple/n' alguna/s de las siguientes condiciones...
a) que las celdas de la columna 'B' contengan el caracter '@'
b) que el 'contenido' de la celda 'C' pueda ser evaluado como un nombre [y ruta ?] de archivo 'existente' -?-

2) prueba con una macro +/- como la siguiente -> seleccionando cada celda 'brincada' de la columna 'C'...
Sub Verifica_existencia_del_archivo()
Dim Celda As Range
For Each Celda In Selection
If Celda <> "" Then _
MsgBox "El archivo indicado en " & Celda.Address & vbCr & _
IIf(Dir(Celda) <> "", "SI", "=> NO") & " es un archivo existente !!!" & vbCr & Celda
Next
End Sub

si cualquier duda [o informacion adicional]... comentas ?
saludos,
hector.

__ el codigo expuesto __
Private Sub CommandButton1_Click()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim cell As Range, FileCell As Range
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Sheets("Hoja1").Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And Application.WorksheetFunction.CountA( _
Sheets("Hoja1").Cells(cell.Row, 1).Range("C1:F1")) > 0 Then
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = cell.Value
.Subject = "Testfile"
.Body = "Hi " & cell.Offset(0, -1).Value
'Enter the file names in the C:F column in each row
'You can make the range bigger if you want, only change the column not the 1
For Each FileCell In Sheets("Hoja1").Cells(cell.Row, 1).Range("C1:F1") _
.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell
.Display 'Or use Send
End With
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub