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 = "[email protected]"
.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]

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

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 = "[email protected]" .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.

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

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

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