Regouin
03-16-2005, 12:38 AM
I have written a bit of code to be able to copy the visible rows of the first worksheet to a new workbook and then be able to send the workbook to 1 recipient, I only want to be able, preferably via an inputbox, to select multiple recipients I'll put down the code as I have it now.
Sub sendmail()
Dim fsoObj As Object
Dim Fs As Object
Dim strPath As String
Dim strFileMask As String
Dim f As String
Dim stKallFil As String
Dim recipients As String
Dim weeknummer As Range
Dim week As Range
Set fsoObj = CreateObject("Scripting.FileSystemObject")
Set week = Worksheets("totaal").Range("h1")
Set Fs = CreateObject("Scripting.FileSystemObject")
If MsgBox(strExcelApp & "Onderhoudsgegevens versturen?", vbYesNo + vbQuestion) = vbNo Then
Exit Sub
End If
Application.DisplayAlerts = False
Application.EnableEvents = False
With fsoObj
If .FolderExists("c:\tempmail\") Then
Else
.CreateFolder ("c:\tempmail\")
End If
Application.ScreenUpdating = False
Dim Wkb As Workbook
Range("A:A").SpecialCells(xlCellTypeVisible).EntireRow.Copy
Set Wkb = Workbooks.Add
Wkb.Sheets(1).Paste
Application.CutCopyMode = False
Dim Shp As Shape
For Each Shp In Wkb.Sheets(1).Shapes
Shp.Delete
Next
Set Wkb = Nothing
recipients = InputBox(Prompt:="Voer adres ontvanger in", Default:="user@domain.com")
ActiveWorkbook.Sheets("blad1").Columns("A").AutoFit
ActiveWorkbook.SaveAs Filename:="C:\tempmail\onderhoud na week " & week & ".xls", CreateBackup:=False
ActiveWorkbook.sendmail recipients, "Te plegen onderhoud na week " & week
ActiveWindow.Close
On Error Resume Next
Kill "C:\tempmail\*.*"
RmDir "C:\tempmail"
End With
Set fsoObj = Nothing
End Sub
Now i have another question regarding this, would it be able to have the sheet that I have exported to a new workbook instead export it to Word and then lose the excel look (so no more fancy tables).
TIA
frank
Sub sendmail()
Dim fsoObj As Object
Dim Fs As Object
Dim strPath As String
Dim strFileMask As String
Dim f As String
Dim stKallFil As String
Dim recipients As String
Dim weeknummer As Range
Dim week As Range
Set fsoObj = CreateObject("Scripting.FileSystemObject")
Set week = Worksheets("totaal").Range("h1")
Set Fs = CreateObject("Scripting.FileSystemObject")
If MsgBox(strExcelApp & "Onderhoudsgegevens versturen?", vbYesNo + vbQuestion) = vbNo Then
Exit Sub
End If
Application.DisplayAlerts = False
Application.EnableEvents = False
With fsoObj
If .FolderExists("c:\tempmail\") Then
Else
.CreateFolder ("c:\tempmail\")
End If
Application.ScreenUpdating = False
Dim Wkb As Workbook
Range("A:A").SpecialCells(xlCellTypeVisible).EntireRow.Copy
Set Wkb = Workbooks.Add
Wkb.Sheets(1).Paste
Application.CutCopyMode = False
Dim Shp As Shape
For Each Shp In Wkb.Sheets(1).Shapes
Shp.Delete
Next
Set Wkb = Nothing
recipients = InputBox(Prompt:="Voer adres ontvanger in", Default:="user@domain.com")
ActiveWorkbook.Sheets("blad1").Columns("A").AutoFit
ActiveWorkbook.SaveAs Filename:="C:\tempmail\onderhoud na week " & week & ".xls", CreateBackup:=False
ActiveWorkbook.sendmail recipients, "Te plegen onderhoud na week " & week
ActiveWindow.Close
On Error Resume Next
Kill "C:\tempmail\*.*"
RmDir "C:\tempmail"
End With
Set fsoObj = Nothing
End Sub
Now i have another question regarding this, would it be able to have the sheet that I have exported to a new workbook instead export it to Word and then lose the excel look (so no more fancy tables).
TIA
frank