Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
help with this code
Hello
i need a little help with this code. it works fine except the second spreadsheet isnt being attached to the email that is created. why? Sub SaveWorkbook() Dim USRNM As String Dim SunDT As String Dim strFName As String Dim wsh As Object Dim fs As Object Dim DocPath As String Dim DirString As String Dim OutApp As Object Dim OutMail As Object Set wsh = CreateObject("WScript.Shell") Set fs = CreateObject("Scripting.FileSystemObject") DocPath = wsh.SpecialFolders.Item("mydocuments") DirString = DocPath & "\TimeCards" With ActiveSheet USRNM = .Range("EmployeeName").Value SunDT = Format(.Range("SundayDate").Value, "yy-dd-mmm") If Trim(USRNM) = "" Or Trim(SunDT) = "" Then MsgBox "Please add Employee Name and Sunday's Date" & vbLf & "File not saved!" TimeCardInfo.Show Exit Sub End If 'create a new workbook to email With ActiveSheet Sheets("Weekly Time Record").Select Sheets("Weekly Time Record").Copy 'remove button and 2nd row in email version ActiveSheet.Unprotect Password:="service" ActiveSheet.DrawingObjects.Select Selection.Delete ActiveSheet.Rows(2).Delete ActiveSheet.Protect Password:="service" If Not fs.FolderExists(DirString) Then fs.CreateFolder DirString End If strFName = "Time Card " & SunDT & " " & USRNM & ".xls" .Parent.SaveAs DirString & "\" & strFName 'email the non VBA copy to the address using outlook 2003 Set OutApp = CreateObject("Outlook.Application") OutApp.Session.Logon Set OutMail = OutApp.CreateItem(0) On Error Resume Next With OutMail .To = " .CC = "" .BCC = "" .Subject = strFName .Body = "Here is the time card for the period starting " & SunDT .Attachments.Add ActiveWorkbook.FullName .Display Application.Wait (Now + TimeValue("0:00:01")) 'use send button to cause the email to be sent Application.SendKeys ("%(s)") End With On Error GoTo 0 Set OutMail = Nothing Set OutApp = Nothing End With Application.Wait (Now + TimeValue("0:00:03")) Application.Quit End With End Sub i had originally had the code working a different way but it wouldnt remove the button and 2nd row. this is the original code: Sub SaveWorkbook() Dim USRNM As String Dim SunDT As String Dim strFName As String Dim wsh As Object Dim fs As Object Dim DocPath As String Dim DirString As String Dim OutApp As Object Dim OutMail As Object Set wsh = CreateObject("WScript.Shell") Set fs = CreateObject("Scripting.FileSystemObject") DocPath = wsh.SpecialFolders.Item("mydocuments") DirString = DocPath & "\TimeCards" With ActiveSheet USRNM = .Range("EmployeeName").Value SunDT = Format(.Range("SundayDate").Value, "yy-dd-mmm") If Trim(USRNM) = "" Or Trim(SunDT) = "" Then MsgBox "Please add Employee Name and Sunday's Date" & vbLf & "File not saved!" TimeCardInfo.Show Exit Sub Else 'create a new workbook to email Sheets("Weekly Time Record").Select Sheets("Weekly Time Record").Copy 'remove button and 2nd row in email version ActiveSheet.Unprotect Password:="service" ActiveSheet.DrawingObjects.Select Selection.Delete ActiveSheet.Rows(2).Delete ActiveSheet.Protect Password:="service" If Not fs.FolderExists(DirString) Then fs.CreateFolder DirString End If strFName = "Time Card " & SunDT & " " & USRNM & ".xls" ActiveWorkbook.Parent.SaveAs DirString & "\" & strFName End If 'email the non VBA copy to the address using outlook 2003 Set OutApp = CreateObject("Outlook.Application") OutApp.Session.Logon Set OutMail = OutApp.CreateItem(0) On Error Resume Next With OutMail .To = " .CC = "" .BCC = "" .Subject = strFName .Body = "Here is the time card for the period starting " & SunDT .Attachments.Add ActiveWorkbook.FullName .Display Application.Wait (Now + TimeValue("0:00:01")) 'use send button to cause the email to be sent Application.SendKeys ("%(s)") End With On Error GoTo 0 Set OutMail = Nothing Set OutApp = Nothing Application.Wait (Now + TimeValue("0:00:03")) Application.Quit End With End Sub i figured that the else part of the if wasnt really necessary so i moved it out. but now it seems to create a new workbook then save another copy of the original workbook then it goes to close the application and it asks me to save the workbook which i copied the sheet to and removed the button and 2nd row from, which wasnt attached to the email. just typing this i think that i just need to check the timing of things, but any help is still appreciated. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
split post code (zip code) out of cell that includes full address | Excel Discussion (Misc queries) | |||
Shorten code to apply to all sheets except a few, instead of individually naming them, and later adding to code. | Excel Programming | |||
Protect Sheet with code, but then code will not Paste error. How do i get around this. Please read for explainations.... | Excel Programming | |||
How to assign same code inside Option button code space ?? | Excel Programming | |||
Excel code convert to Access code - Concat & eliminate duplicates | Excel Programming |