UserForm Question

[TotallyConfused]

Hi I have a Userform that will be used to be accessible on a sharedrive. My
form right now captures the data entry on the form adds it to the worksheet
and when it is sent via email. The receiver receives the form blank but the
worksheet has the data. How do I only sent the worksheet or how do I sent
the form with the data and the worksheet. I prefer that the receiver only
receives the worksheet with the data. Thank you

 

[Joel]

Before sending the worksheet do a copy of the worksheet which will create a
new workbook. then sent the sheet from the new workbook

If you do copy without using after or before a new workbook is created

with activeworkbook.activesheet
.copy ' create new workbook with one worksheet
set newbk = activeworkbook
set newsht = newbk.sheets(1)
end with


Then email either the new sheet or new workbook the way you were previously
emailing the original sheet.

 

[TotallyConfused]

Hi Joel, this is the code I currently have to email the userform. I am not
sure where I need to make the change so that when the form is emailed the
receiver only receives the worksheet with the data. Can you please help me
where to change this? Thank you.


Private Sub OutMail_Click()
'Working in 2000-2007
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim OutApp As Object
Dim OutMail As Object

Set wb1 = ActiveWorkbook

If Val(Application.Version) >= 12 Then
If wb1.FileFormat = 51 And wb1.HasVBProject = True Then
MsgBox "There is VBA code in this xlsx file, there will be no
VBA code in the file you send." & vbNewLine & _
"Save the file first as xlsm and then try the macro
again.", vbInformation
Exit Sub
End If
End If

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

'Make a copy of the file/Open it/Mail it/Delete it
'If you want to change the file name then change only TempFileName
TempFilePath = Environ$("temp") & "\"
TempFileName = "Copy of " & wb1.Name & " " & Format(Now, "dd-mmm-yy")
FileExtStr = "." & LCase(Right(wb1.Name, Len(wb1.Name) -
InStrRev(wb1.Name, ".", , 1)))

wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
Set wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = "myemailaddress"
'.CC = ""
.BCC = ""
.Subject = "Report Request"
.Body = "Report Request attached."
.Attachments.Add wb2.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Display 'or use .Display
End With
On Error GoTo 0

wb2.Close SaveChanges:=False

'Delete the file
Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

 

[Joel]

I made a few minor changes in the code to only send the activeworksheet. The
code crteates a new workbook by copying only the active worksheet. Then
sends only the one sheet workbook. I put comments into the code showing my
changes

Private Sub OutMail_Click()
'Working in 2000-2007
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim OutApp As Object
Dim OutMail As Object

Set wb1 = ActiveWorkbook


'--------- New Line -------------------
set Sht1 = ActiveSheet

If Val(Application.Version) >= 12 Then
If wb1.FileFormat = 51 And wb1.HasVBProject = True Then
MsgBox "There is VBA code in this xlsx file, there will be no
VBA code in the file you send." & vbNewLine & _
"Save the file first as xlsm and then try the macro
again.", vbInformation
Exit Sub
End If
End If

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

'Make a copy of the file/Open it/Mail it/Delete it
'If you want to change the file name then change only TempFileName
TempFilePath = Environ$("temp") & "\"
TempFileName = "Copy of " & wb1.Name & " " & Format(Now, "dd-mmm-yy")
FileExtStr = "." & LCase(Right(wb1.Name, Len(wb1.Name) -
InStrRev(wb1.Name, ".", , 1)))

'---------------------Added two lines
'create new workbook with only one sheet, the active sheet
Sht1.copy
set wb2 = activeworkbook

'------------changed wb1 to wb2
wb2.SaveCopyAs TempFilePath & TempFileName & FileExtStr

'--------------------commented out line
'Set wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = "myemailaddress"
'.CC = ""
.BCC = ""
.Subject = "Report Request"
.Body = "Report Request attached."
.Attachments.Add wb2.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Display 'or use .Display
End With
On Error GoTo 0

wb2.Close SaveChanges:=False

'Delete the file
Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

 

[TotallyConfused]

Hi Joel thank you for responding. However, I changed the code I had and
replaced it with the code you provided. The form allows me to enter data and
email but when I tested it, the receive does not receive the worksheet as an
attachment or in the body of the email. Is there something I need to do
more? can you please help? When I go to the code the following lines of
code are in RED:

VBA code in the file you send." & vbNewLine & _
"Save the file first as xlsm and then try the macro
again.", vbInformation



FileExtStr = "." & LCase(Right(wb1.Name, Len(wb1.Name) -
InStrRev(wb1.Name, ".", , 1)))


Thank you for your help very much appreciated.

 

[Joel]

The website corrupts long lines of code which create errors. Yo can use the
line continuation character (_) at the end of the line to shorten the lines
so the error doesn't happen or just take the error lines and make them one
line like in you oringal code that you posted. if you compare your original
code to the code that is on the webpage you will see the differences. it has
nothing to do with any of my changes.


I added the line continuation at the end of the 1st line
FileExtStr = "." & LCase(Right(wb1.Name, Len(wb1.Name) - _
InStrRev(wb1.Name, ".", , 1)))

I split the long string into two string and again aded the line continuation
character . copy the line below to get rid of the error
If wb1.FileFormat = 51 And wb1.HasVBProject = True Then
MsgBox "There is VBA code in this xlsx file, " & _
"there will be no VBA code in the file you send." &
vbNewLine & _
"Save the file first as xlsm and then try the macro again.", _
vbInformation