Saltar al contenido

Enviar mail con macro


Recommended Posts

Buenas, tengo un problema con estos codigos. El siguiente, me falla en la parte del codigo donde graba el archivo temporal (negrita). y Me aparece el siguiente mensaje de eror al depurar:

Se ha producido el error '1004' en tiempo de ejecucion:

No se puede tener acceso al archivo. Intente lo siguiente:

Compruebe que la carpeta especificada existe
Compruebe que la carpeta que contiene el archivo no es de solo lectura
Compruebe que el archivo no contiene ninguno de los siguientes caracteres: < > ? [ ] : o *[/HTML]

Lo extraño es que anteriormente funcionaba facilmente y lo unico que hice antes de que dejara de funcionar es cambiarle el nombre de la hoja a enviar.

[CODE]Sub EmailtraspasoP()
'Working in 2000-2010
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim TheActiveWindow As Window
Dim TempWindow As Window

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set Sourcewb = ActiveWorkbook

'Copy the sheets to a new workbook
'We add a temporary Window to avoid the Copy problem
'if there is a List or Table in one of the sheets and
'if the sheets are grouped
With Sourcewb
Set TheActiveWindow = ActiveWindow
Set TempWindow = .NewWindow
.Sheets("Traspasos Permanentes").Copy
End With

'Close temporary Window
TempWindow.Close

Set Destwb = ActiveWorkbook

'Determine the Excel version and file extension/format
With Destwb
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2010, we exit the sub when your answer is
'NO in the security dialog that you only see when you copy
'an sheet from a xlsm file with macro's disabled.
If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Your answer is NO in the security dialog"
Exit Sub
Else

Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End If
End With

'Change all cells in the worksheets to values if you want
For Each sh In Destwb.Worksheets
sh.Select
With sh.UsedRange
.Cells.Copy
.Cells.PasteSpecial xlPasteValues
.Cells(1).Select
End With
Application.CutCopyMode = False
Destwb.Worksheets(1).Select
Next sh


'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
TempFileName = "Traspasos Permanentes " & Sourcewb.Name & " " _
& Format(Now, "dd/mm/yyyy a las hh:mm")

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, _
FileFormat:=FileFormatNum

With OutMail
.To = "aaaaa@ar.iveco.com"
.CC = ""
.BCC = ""
.Subject = "Traspasos Permanentes" & Sourcewb.Name & " " _
& Format(Now, "dd/mm/yyyy hh:mm")
.Body = "Han habido Traspasos Permanantes de Personal en la" & " " & Sourcewb.Name & " " _
& "el dia " & Format(Now, "dd/mm/yyyy a las hh:mm")
.Attachments.Add Destwb.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With

.Close SaveChanges:=False

End with
'Delete the file you have send
Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub[/CODE]

Enlace a comentario
Compartir con otras webs

Hola:

Cuando usas macros y estableces nombres de hojas, estas se mantienen en la macro y no se actualizan si las cambias en el libro, la solucion mas facil para esto, y actualizarlo tu mismo es:

1. Busca en tu macro el nombre de tu Hoja anterior.

2. Reemplazalo por el nuevo, y veras que todo te va como antes.

Para enviar un mail hay varias opciones, deseas mandar todo el libro? o solo una hoja?

Espero te sirva,

Saludos,

Fernando

Enlace a comentario
Compartir con otras webs

Hola enferchats:

Gracias por responder, cuando me referia a cambiar el nombre de la hoja, me referia a que lo habia hecho dentro de la macro....

En principio estoy probando con enviar una hoja unicamente.


.SaveAs TempFilePath & TempFileName & FileExtStr, _ FileFormat:=FileFormatNum
[/PHP]

Esa es la parte del codigo que me marca al depurar, es decir, por lo que entiendo no es capaz de grabar el libro, bajo los parametros que establece el codigo. La cuestion es por que, si antes podia.

El codigo sin cambio asi como lo extraje de la pagina Ron's excel Tips es el siguiente. Lo que no encuentro es el cambio que me genera el error en mi codigo.

[PHP]
Sub Mail_Sheets_Array() 'Working in 2000-2010 Dim FileExtStr As String Dim FileFormatNum As Long Dim Sourcewb As Workbook Dim Destwb As Workbook Dim TempFilePath As String Dim TempFileName As String Dim OutApp As Object Dim OutMail As Object Dim sh As Worksheet Dim TheActiveWindow As Window Dim TempWindow As Window With Application .ScreenUpdating = False .EnableEvents = False End With Set Sourcewb = ActiveWorkbook 'Copy the sheets to a new workbook 'We add a temporary Window to avoid the Copy problem 'if there is a List or Table in one of the sheets and 'if the sheets are grouped With Sourcewb Set TheActiveWindow = ActiveWindow Set TempWindow = .NewWindow .Sheets(Array("Sheet1", "Sheet3")).Copy End With 'Close temporary Window TempWindow.Close Set Destwb = ActiveWorkbook 'Determine the Excel version and file extension/format With Destwb If Val(Application.Version) < 12 Then 'You use Excel 97-2003 FileExtStr = ".xls": FileFormatNum = -4143 Else 'You use Excel 2007-2010, we exit the sub when your answer is 'NO in the security dialog that you only see when you copy 'an sheet from a xlsm file with macro's disabled. If Sourcewb.Name = .Name Then With Application .ScreenUpdating = True .EnableEvents = True End With MsgBox "Your answer is NO in the security dialog" Exit Sub Else Select Case Sourcewb.FileFormat Case 51: FileExtStr = ".xlsx": FileFormatNum = 51 Case 52: If .HasVBProject Then FileExtStr = ".xlsm": FileFormatNum = 52 Else FileExtStr = ".xlsx": FileFormatNum = 51 End If Case 56: FileExtStr = ".xls": FileFormatNum = 56 Case Else: FileExtStr = ".xlsb": FileFormatNum = 50 End Select End If End If End With ' 'Change all cells in the worksheets to values if you want ' For Each sh In Destwb.Worksheets ' sh.Select ' With sh.UsedRange ' .Cells.Copy ' .Cells.PasteSpecial xlPasteValues ' .Cells(1).Select ' End With ' Application.CutCopyMode = False ' Destwb.Worksheets(1).Select ' Next sh 'Save the new workbook/Mail it/Delete it TempFilePath = Environ$("temp") & "\" TempFileName = "Part of " & Sourcewb.Name & " " _ & Format(Now, "dd-mmm-yy h-mm-ss") Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) With Destwb .SaveAs TempFilePath & TempFileName & FileExtStr, _ FileFormat:=FileFormatNum On Error Resume Next With OutMail .To = "ron@debruin.nl" .CC = "" .BCC = "" .Subject = "This is the Subject line" .Body = "Hi there" .Attachments.Add Destwb.FullName 'You can add other files also like this '.Attachments.Add ("C:\test.txt") .Send 'or use .Display End With On Error GoTo 0 .Close SaveChanges:=False End With 'Delete the file you have send Kill TempFilePath & TempFileName & FileExtStr Set OutMail = Nothing Set OutApp = Nothing With Application .ScreenUpdating = True .EnableEvents = True End With End Sub
[/PHP]

Para ser mas claro con otro macro yo creo una hoja donde cargo los datos y le coloco el nombre "Traspasos Permanentes" y eso es lo que deseo copiar y mandar por email.

Esta hoja solo tiene datos en el Range("A1:L2"), y por eso tambien intente enviar solamente ese rango en el cuerpo del email pero esto ni siquiera me funciono.

O sea el codigo para enviar la hoja, si me funcionaba en un primer momento.

Enlace a comentario
Compartir con otras webs

Lo que entiendo es que con una macro creas una hoja nueva y copias algunos datos y le pones cierto nombre.

Y lo que deseas es esa hoja enviarla por correo no?. Si es asi te copio un codigo que te podria ayudar

Sub enviar()

Dim wb As Workbook

Dim strEmail As String

strEmail = (direccion a donde la quieres enviar, puedes usar el valor d una celda)

asunto = (pones el nombre del asunto que saldra en el mail, ejem: "CONFIRMAR RECEPCION")

Set wb = ActiveWorkbook

With wb

.SaveAs nombre & ".xls"

.SendMail strEmail, asunto

.ChangeFileAccess xlReadOnly

Kill .FullName

.Close False

End With

End Sub

a mi me sirvio mucho este codigo, pruebalo y espero te solucione el problema

Enlace a comentario
Compartir con otras webs

Esta bueno ese codigo, pero el problema es que a mi me sirve el que yo puse (si funcionara). Esto por que el de arriba, copia la hoja con datos incluidos a un nuevo libro, lo graba en temporales, lo envia, y lo borra todo esto desde el archivo desde donde se creo aquella hoja de la que hablabamos.

El codigo que vos compartis conmigo, necesitaria ejecutarse (si mal no entiendo) desde el nuevo libro. Puesto que si yo ejecutara ese codigo desde el libro principal, dado que posee muchas otras hojas, creo que tiraria error.

La verdad es que no tengo los conocimientos actualmente como para adaptar ese codigo al que yo coloco primero. Colocar el macro en el libro no es una opcion, a menos que se ejecute solo y luego lo borre cosa que desconozco si puede hacerse.

Saludos

Enlace a comentario
Compartir con otras webs

BUeh, finalmente despues de releer el codigo 830 mil veces, probando 732 mil cambios distintos, descubri donde se hallaba el error, aunque todavia no descubri cual era el error.

El error estaba en la linea que define y asigna el nombre al archivo temporal a grabar con el nuevo libro creado.

Asi estaba inicialmente en el modulo del mencionado autor de la macro:

   TempFileName = "Part of " & Sourcewb.Name & " " _
& Format(Now, "dd-mmm-yy h-mm-ss")[/CODE]

Estos son los cambios que yo le hice y donde aparentenemente dejo de funcionar

[CODE]
TempFileName = "Traspasos Permanentes " & Sourcewb.Name & " " _
& Format(Now, "dd/mm/yyyy a las hh:mm")[/CODE]

El error esta en las "/" que separan la mascara de los dias y los ":" que separan las horas. Dado que es un nombre de libro solo puede utilizarse "-" o "_". Bueno saludos, gracias por las respuestas. Y disculpen el post tan inservible que acavo de crear :culpability:.

pueden colocarlo como solucionado

Enlace a comentario
Compartir con otras webs

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

  • 97 ¿Te parecen útiles los tips de las funciones? (ver tema completo)

    1. 1. ¿Te parecen útiles los tips de las funciones?


      • No
      • Ni me he fijado en ellos

  • Ayúdanos a mejorar la comunidad

    • Donaciones recibidas este mes: 0.00 EUR
      Objetivo: 130.00 EUR
  • Archivos

  • Estadísticas de descargas

    • Archivos
      177
    • Comentarios
      90
    • Revisiones
      27

  • Crear macros Excel

  • Mensajes

    • Hola que tal amigos programadores por favor me podrían ayudar con una macro que me genere un archivo CSV delimitado por comas, la estructura del archivo CSV no deberá llevar encabezado, los datos del archivo CSV serán obtenidos de la hoja “Datos”. En la columna A: deberá tener la clave clues que se toma de la columna B de la hoja Datos En la Columna B: el Código (son 230 codigos que van del rango G1:IB1 de la hoja datos) En la Columna C: el valor almacenado a su correspondiente al código y clues En la Columna D: el número del mes que se obtendrá de la de la columna E de la hoja Datos En la Columna E: el año que se tomará de la columna F de la hoja de Datos   Son 230 códigos por lo que la macro generará 230 filas por cada clave clues que tenga la hoja Datos En el archivo anexo una hoja llamada CSV para que vean la estructura que tendrá, el archivo CSV estará delimitado por comas   Les agradecería mucho que me ayuden por favor, Dios los bendiga Exportar datos a csv.xlsx
    • Hola buenas tardes.   Debido al trabajo debo estar comparando en un periodo unos archivos dentro de una carpeta o subcarpeta. en base a la fecha de creacion o modificacion.  pero tengo que estar viendo carpeta por carpeta y aveces son varios. Con una macro intente  listar los archivos de cualquier carpeta y subcarpeta, esto activandolo segun la celdaactiva. El problema es que tiene algunos errores. 1. si la carpeta cuenta con subcarpetas me los manda a muchas filas abajo. Mi idea es hoja(Así debe quedar) Que con una macro pueda seleccionar la carpeta desde el buscador y me de la lista de archivos a partir de la fila 6. siendo columna A= fecha de modificación, columna B =Fecha de creación y columna C=Nombre del archivo con hiperlink. Con otro o con la misma macro poder seleccionar otra carpeta y sus subcarpetas, según sea el caso. y me liste a partir de la columna F de la fila 6 Siendo La columna F=Nombre del archivo, columna H=fecha de creación, columna I=ultima modificación   Para así poder acceder y comparar mis archivos, directamente desde excel.   Muchas gracias Mariano       Listar archivos de 2 carpetas para comparar.xlsm
    • Hola buenas, Os presento mis dudas. Tengo un libro  (llamémosle LibroDestino) con dos módulos, uno de definición de variables "ModDef" y otro de inicializacion de esas mismas variables "ModCfg". Necesito que al copiarme una hoja de otro libro(llamémosle LibroOrigen), mediante un procedimiento, sobrescribir el modulo de inicialización de variables del LibroDestino con el  contenido del módulo que hay en el LibroOrigen. Destacar que los dos módulos de cada libro tienen el mismo nombre "ModCfg". Y tienen una única variable llamada "Mensaje". En el LibroDestino tiene el valor "Hola" y en el LibroOrigen el valor "Adiós" Este procedimiento lo realiza perfectamente,  es decir se sobrescribe, pero si en el mismo procedimiento quiero utilizar el nuevo valor de esa variable, me conserva el valor de la variable anterior. Para hacer las comprobaciones he ejecutado un MsgBox al empezar y al acabar el procedimiento, pero en los dos casos me devuelve el valor original del LibroDestino el valor "Hola", cuando mi idea es que al sobrescribir el modulo con el nuevo valor de la variable, el último MsgBox me devuelva el valor "Adios". Mi objetivo es poder tener la inicialización de esas variables en un libro que no sea el de trabajo (LibroDestino), ya que según la hoja que importe puedo requerir que las variables tengan un valor u otro. ¿Por que no me coge en el procedimiento el nuevo valor de la variable? ¿Cómo podría conseguirlo? He tenido que activar en VBA  la referencia Microsoft visual basic for applications extensibility 5.3 desde  Herramientas -> Referencias. Creo que es la única manera de poder trabajar con los módulos desde VBA, aunque si se pudiera de otra manera creo que sería mas óptimo. Mil gracias de antemano, un saludo!         Libro1_Prueba.xlsm Libro2_Prueba.xlsm
    • Agradecido Antoni! Tus sugerencias me ayudaron mucho! Como pudiese hacerte llegar el archivo?
    • Prueba este código. Sin el archivo no te puedo ajustar más. Private Sub btnCargaBancos_Click() 'El tipo de dato debe especificase para cada variable Dim TasaCompra As Double, TasaVenta As Double, InvBanesco As Double, InvVzla As Double Dim MontoBanesco As Double, MontoVzla As Double, TasaDiaBan As Double, TasaDiaVzla As Double Dim TasaActual As Double 'Hay que comprobar que los textbox tienen contenido numérico 'Los datos numéricos solo pueden contener números y el separador decimal, cualquier otro caracter dará error al convertir If Not IsNumeric(txtInverBanesco) Or _ Not IsNumeric(txtInverVzla) Or _ Not IsNumeric(txtTasaCompra) Or _ Not IsNumeric(txtTasaVenta) Then MsgBox "Los datos deben ser numéricos", vbCritical Exit Sub End If InvBanesco = CDbl(txtInverBanesco) InvVzla = CDbl(txtInverVzla) TasaCompra = CDbl(txtTasaCompra) TasaVenta = CDbl(txtTasaVenta) 'Los datos de los divisores no pueden ser 0 (Indeterminación matemática) If TasaCompra = 0 Or _ InvBanesco = 0 Or _ InvVzla = 0 Then MsgBox "Los datos no admiten valor cero", vbCritical Exit Sub End If MontoBanesco = (InvBanesco / TasaCompra) * (1 - 0.18 / 100) * (TasaVenta * (1 - 0.18 / 100)) MontoVzla = (InvVzla / TasaCompra) * (1 - 0.18 / 100) * (TasaVenta * (1 - 0.18 / 100)) TasaDiaBan = (MontoBanesco / InvBanesco) * (1 - 0.055) TasaDiaVzla = (MontoVzla / InvVzla) * (1 - 0.055) If TasaDiaBan < TasaDiaVzla Then TasaActual = TasaDiaBan Else TasaActual = TasaDiaVzla End If 'En VBA, los datos numéricos no admiten ser formateados, formatear directamente en las celdas, 'MontoBanesco = FormatNumber(MontoBanesco, 2, True, vbFalse) 'MontoVzla = FormatNumber(MontoVzla, 2, True, vbFalse) 'TasaActual = FormatNumber(TasaActual, 5, True, False) txtBcoBanesco = MontoBanesco txtBcoVenezuela = MontoVzla txtTasaDiaria = TasaActual End Sub  
  • Visualizado recientemente

    • No hay usuarios registrado para ver esta página.
×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.