Afsendelse af mail med resultater fra excel
Jeg har rodet noget med at lave et regneark med at spørgeskema, hvor jeg skal have en knap til sidst, der sender resultat til mig. Men jeg kan ikke helt få det til at virke. Det er hvad jeg har nået så vidt. Nogen der kan hjælpe mig med, hvad jeg gør galt. Er bestemt ikke en ørn til det her. Der er tale om office 2003 på en XP platform.Sub Mail_Range()
' Works in Excel 2000 through Excel 2007.
Dim Source As Range
Dim Destwb As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Set Source = Nothing
On Error Resume Next
Set Source = Range("A1:G56").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Source Is Nothing Then
MsgBox "The source is not a range or the worksheet is protected. Please correct the problem and try again.", vbOKOnly
Exit Sub
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set wb = ActiveWorkbook
Set Destwb = Workbooks.Add(xlWBATWorksheet)
Source.Copy
With Destwb.Sheets(1)
' The number 8 pastes the column width. Because of
' of a bug in Excel 2000, you must use the number
' instead of "xlPasteColumnWidths".
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With
TempFilePath = Environ$("c:\temp") & "\"
TempFileName = "Selection of spørgeskema" & wb.Name & "xls" & Format(Now, "dd-mmm-yy h-mm-ss")
If Val(Application.Version) < 12 Then
' You are using Excel 2000 through Excel 2003.
FileExtStr = ".xls": FileFormatNum = -4143
Else
' You are using Excel 2007.
FileExtStr = ".xlsx": FileFormatNum = 51
End If
With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
.SendMail "xxxx@xxxx.dk", _
"Spørgeskema IP telefoni"
On Error GoTo 0
.Close SaveChanges:=False
End With
' Delete the file you just sent.
Kill TempFilePath & TempFileName & FileExtStr
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
