Save worksheet as specific file type then email that file - Can it be done with VBA?

[bluedusty]

Hello,

I was given an excel sheet that has been created by someone else which already has a Macro in place. This Macro saves the required information from the worksheet to a specific place on the desktop as an scv or scq file type. Is there anyway that once this information has been generated that I can set the macro to automatically add this to an email pop up? Unfortunately I cant see how and where in the code that the information is saved as a specific file type or to location etc, it says:

' Save workbook before generating file
ActiveWorkbook.Save

Open directory & "\" & fname For Append As #file
Print #file, ****FileData
Close #file

This save's as .PN00001.scvor scvq and the PN goes up by one on each save.

All I would like to do is get this macro to automatically attach this generated file to an email after save. Sorry, I am probably not making much sense at all as I know what I want to achieve but not how to explain it. I am not very familiar with all of this so maybe trying to bite of more than I can chew. Would also need an idea of where to put the code. Can I just add it into the existing macro? If so can I just put the code in after the save section?

Any help would be greatly received.

Thanks

Bluedusty

 

[ManiacB]

This is definitely something you can do. Post your code and we can add in the email portion.

 

[bluedusty]

ManiacB, Thanks for your reply, I hope this helps:

Sub EDSSFileGen()

' Variables
Dim file As Integer
Dim edssFileData As String
Dim ftype As String
Dim orgid As String
Dim fname As String
Dim username As String
Dim directory As String
Dim genNum As String
' Loop variables
Dim gd_index As Integer
Dim gd_length As Integer
' File name generation number variables
Dim nextSeq As Long
Dim currSeq As String
Dim decLimit As Integer

' Variable initialization
fname = fname & Cells(3, "C").Value & "01.PN" & Cells(3, "G").Value & "." & Cells(3, "D").Value
ftype = ftype & Cells(3, "D").Value
orgid = orgid & Cells(3, "C").Value
username = username & Cells(3, "M").Value
directory = directory & Cells(2, "M").Value

' Decmial Place Limit Set
If Trim(Cells(33, "C").Value & vbNullString) = vbNullString Or Not IsNumeric(Cells(33, "C").Value) Then
decLimit = 5
ElseIf Cells(33, "C").Value < 0 Then
decLimit = 5
Else
decLimit = Cells(33, "C").Value
End If


' Validation check for null directory string
If Trim(directory & vbNullString) = vbNullString Then

Dim fldr As FileDialog
Dim selectedfldr As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)

With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = Application.DefaultFilePath
If .Show <> -1 Then GoTo NextCode
selectedfldr = .SelectedItems(1)
End With
NextCode:
GetFolder = selectedfldr
Set fldr = Nothing

directory = selectedfldr
Cells(2, "M").Value = directory
End If

' Validation check for null directory string and null username
If Trim(directory & vbNullString) = vbNullString Or Trim(username & vbNullString) = vbNullString Then
MsgBox "Please enter a username or directory!"
ElseIf Trim(orgid & vbNullString) = vbNullString Or Trim(ftype & vbNullString) = vbNullString Or Trim(Cells(3, "G").Value & vbNullString) = vbNullString Then
MsgBox "Please enter an Organisation ID, File Type and Generation Number!"
Else
file = FreeFile

' -----------------------------
' EDSS File Header
' -----------------------------
edssFileData = edssFileData & 0 & "," '
edssFileData = edssFileData & Cells(3, "C").Value & ","
edssFileData = edssFileData & Cells(3, "D").Value & ","
edssFileData = edssFileData & Format(Cells(3, "E").Value, "yyyyMMdd") & ","
edssFileData = edssFileData & Format(Cells(3, "F").Value, "hhnnss") & ","
edssFileData = edssFileData & Cells(3, "G").Value & ","
edssFileData = edssFileData & Format(Cells(3, "I").Value, "yyyyMMdd")

' Sequence variable initialization
currSeq = Cells(3, "G").Value
nextSeq = CLng(currSeq)

' -----------------------------
' EDSS File Body
' -----------------------------
' Validation check for 23, 24, and 25 Hour Gas Day selection
gd_length = 28 ' Default Gas Day set to 24 Hours
file_seq = 1 ' File sequence starts at 1

If Cells(3, "J").Value = "23 Hour Gas Day" Then
gd_length = 27
ElseIf Cells(3, "J").Value = "24 Hour Gas Day" Then
gd_length = 28
ElseIf Cells(3, "J").Value = "25 Hour Gas Day" Then
gd_length = 29
End If

' Loop through the Gas Hours to populate the data in the file
For gd_index = 5 To gd_length
edssFileData = edssFileData & Chr(13)
edssFileData = edssFileData & 1 & ","
edssFileData = edssFileData & file_seq & ","
edssFileData = edssFileData & Round(Cells(gd_index, "D").Value, decLimit) & ","
edssFileData = edssFileData & Left(Cells(gd_index, "E").Value, 1)

file_seq = file_seq + 1 ' Increment file sequence
Next gd_index

' -----------------------------
' EDSS File Footer
' -----------------------------
edssFileData = edssFileData & Chr(13)

edssFileData = edssFileData & 9 & ","
edssFileData = edssFileData & Cells(31, "C").Value & ","
edssFileData = edssFileData & Round(Cells(31, "D").Value, decLimit) & ","
edssFileData = edssFileData & Round(Cells(31, "E").Value, decLimit) & ","
edssFileData = edssFileData & Cells(31, "F").Value & ","
edssFileData = edssFileData & Cells(31, "G").Value & ","
edssFileData = edssFileData & Cells(31, "H").Value & ","
edssFileData = edssFileData & Cells(31, "I").Value

' Validation check for generation number limit
If nextSeq <= 999999 Then

' -----------------------------
' Used for logging purposes, stored in the Logs Sheet.
' -----------------------------
NextRow = ActiveWorkbook.Worksheets("File Generation Logs").Range("B" & Rows.Count).End(xlUp).Row + 1

ActiveWorkbook.Worksheets("File Generation Logs").Cells(NextRow, "A").Value = username
ActiveWorkbook.Worksheets("File Generation Logs").Cells(NextRow, "B").Value = fname
ActiveWorkbook.Worksheets("File Generation Logs").Cells(NextRow, "C").Value = directory
ActiveWorkbook.Worksheets("File Generation Logs").Cells(NextRow, "D").Value = Cells(3, "E").Value
ActiveWorkbook.Worksheets("File Generation Logs").Cells(NextRow, "E").Value = Cells(3, "F").Value

' -----------------------------
' Validation for incrementing generation number
' -----------------------------
nextSeq = nextSeq + 1

If nextSeq < 10 Then
Cells(3, "G").Value = "00000" & CStr(nextSeq)
ElseIf nextSeq >= 10 And nextSeq <= 99 Then
Cells(3, "G").Value = "0000" & CStr(nextSeq)
ElseIf nextSeq >= 100 And nextSeq <= 999 Then
Cells(3, "G").Value = "000" & CStr(nextSeq)
ElseIf nextSeq >= 1000 And nextSeq <= 9999 Then
Cells(3, "G").Value = "00" & CStr(nextSeq)
ElseIf nextSeq >= 10000 And nextSeq <= 99999 Then
Cells(3, "G").Value = "0" & CStr(nextSeq)
ElseIf nextSeq >= 100000 Then
Cells(3, "G").Value = nextSeq
End If

' Save workbook before generating file
ActiveWorkbook.Save

Open directory & "\" & fname For Append As #file
Print #file, edssFileData
Close #file

' File creation confirmation message
MsgBox "EDSS File " & fname & " Generation was successful! Please check your directory to retrieve your generated files."

Else
' File generation number grater than limit error message
MsgBox "Generation Number Sequence has reached its MAX. Please clear/change your directory and reset the Generation Number to 000001!"
End If
End If
End Sub



As I said the macro works and generates the file how they want it, it would just help me if it would attach the created file to an email that I could send.

Thanks again, very much appreciated

 

[ManiacB]

After ActiveWorkbook.Save, Enter this code

            With CreateObject("outlook.application").CreateItem(0)
                .To = "email@mail.com"
                .Attachments.Add directory & "\" & fname
                .Display
            End With

 

[bluedusty]

Hi ManiacB, Thanks very much for your reply. I had to put it after the file creation confirmation once the macro generated the file but worked a treat. Thanks for your help