Enviar rango de excel con vba
Estimado amigo: estoy tratando de enviar un rango excel atravez de programacion VBA
el codigo es :
Sub Mail_Selection()
Dim source As Range
Dim ColumnCount As Long
Dim FirstColumn As Long
Dim ColumnWidthArray() As Double
Dim lIndex As Long
Dim lCount As Long
Dim dest As Workbook
Dim i As Long
Dim strdate As String
Set source = Nothing
On Error Resume Next
Set source = Range("A1:I15").SpecialCells(xlCellTypeVisible)
Range("A1:I15").Select
On Error GoTo 0
If source Is Nothing Then
MsgBox "The selection is not a range or the sheet is protect, please correct and try again.", vbOKOnly
Exit Sub
End If
Application.ScreenUpdating = False
ColumnCount = Selection.Columns.Count
FirstColumn = Selection.Cells(1).Column - 1
ReDim ColumnWidthArray(1 To ColumnCount)
lIndex = 0
For lCount = 1 To ColumnCount
If Columns(FirstColumn + lCount).Hidden = False Then
lIndex = lIndex + 1
ColumnWidthArray(lIndex) = Columns(FirstColumn + lCount).ColumnWidth
End If
Next lCount
Set dest = Workbooks.Add(xlWBATWorksheet)
source.Copy
With dest.Sheets(1)
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
For i = 1 To lIndex
.Columns(i).ColumnWidth = ColumnWidthArray(i)
Next
End With
strdate = Format(Now, "dd-mm-yy h-mm-ss")
With dest
.SaveAs "Selection of " & ThisWorkbook.Name _
& " " & strdate & ".xls"
.SendMail "[email protected]", "Envios.xls"
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False
End With
Application.ScreenUpdating = True
End Sub
El problema lo tengo en que "objeto no reconoce el metodo sendmail worsheet" error 1004. Crees que falte activar alguna aplicacion?
el codigo es :
Sub Mail_Selection()
Dim source As Range
Dim ColumnCount As Long
Dim FirstColumn As Long
Dim ColumnWidthArray() As Double
Dim lIndex As Long
Dim lCount As Long
Dim dest As Workbook
Dim i As Long
Dim strdate As String
Set source = Nothing
On Error Resume Next
Set source = Range("A1:I15").SpecialCells(xlCellTypeVisible)
Range("A1:I15").Select
On Error GoTo 0
If source Is Nothing Then
MsgBox "The selection is not a range or the sheet is protect, please correct and try again.", vbOKOnly
Exit Sub
End If
Application.ScreenUpdating = False
ColumnCount = Selection.Columns.Count
FirstColumn = Selection.Cells(1).Column - 1
ReDim ColumnWidthArray(1 To ColumnCount)
lIndex = 0
For lCount = 1 To ColumnCount
If Columns(FirstColumn + lCount).Hidden = False Then
lIndex = lIndex + 1
ColumnWidthArray(lIndex) = Columns(FirstColumn + lCount).ColumnWidth
End If
Next lCount
Set dest = Workbooks.Add(xlWBATWorksheet)
source.Copy
With dest.Sheets(1)
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
For i = 1 To lIndex
.Columns(i).ColumnWidth = ColumnWidthArray(i)
Next
End With
strdate = Format(Now, "dd-mm-yy h-mm-ss")
With dest
.SaveAs "Selection of " & ThisWorkbook.Name _
& " " & strdate & ".xls"
.SendMail "[email protected]", "Envios.xls"
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False
End With
Application.ScreenUpdating = True
End Sub
El problema lo tengo en que "objeto no reconoce el metodo sendmail worsheet" error 1004. Crees que falte activar alguna aplicacion?
1 respuesta
Respuesta de Roberto Alvarado
1