Macro to save as filename and sheet name

[markthomas]

Hi All,

I am a bit of a novice using VBA code. I am trying to convert a multiple sheet excel file into a pipe delimited .dat file. I have found a code that does this (please see below). My problem is that I would like it to name the .dat file based on a combination of the excel file name and the sheet name. If the file was "house.xls" and I was on sheet 45 I would want the macro to save a file called "house45.dat" to a specified location. I hope someone can help here I have come a long way lately with these codes and need this to finish a very helpful macro. Any help would be appreciated.
Thanks
Mark



Sub test()
Dim SrcRg As Range
Dim CurrRow As Range
Dim CurrCell As Range
Dim CurrTextStr As String
Dim ListSep As String
Dim DataTextStr As String
ListSep = "|"
Set SrcRg = ActiveSheet.UsedRange
Open "c:\data.dat " For Output As #1
For Each CurrRow In SrcRg.Rows
CurrTextStr = ""
For Each CurrCell In CurrRow.Cells
CurrTextStr = CurrTextStr & CurrCell.Value & ListSep
Next
While Right(CurrTextStr, 1) = ListSep
CurrTextStr = Left(CurrTextStr, Len(CurrTextStr) - 1)
Wend
'Added next line to put | at end of each line
CurrTextStr = CurrTextStr & ListSep
Print #1, CurrTextStr
Next
Close #1

End Sub

[GTO]

Greetings Mark,

I see it is your first post and you just joined. Welcome to vbaexpress!

In a Standard Module, try:


Option Explicit

Sub test()
Dim SrcRg As Range
Dim CurrRow As Range
Dim CurrCell As Range
Dim CurrTextStr As String
Dim ListSep As String
Dim DataTextStr As String

Dim strFileName As String

'// Get the user's choice for a filename, supplying the suggested filename. //
strFileName = Application.GetSaveAsFilename( _
InitialFileName:=Left(ThisWorkbook.Name, _
InStrRev(ThisWorkbook.Name, ".") - 1) & ActiveSheet.Index, _
FileFilter:="Dat Files (*.dat),*.dat", _
Title:="SaveAs")
'// If the user cancels, bail out... //
If CStr(strFileName) = "False" Then Exit Sub

ListSep = "|"

Set SrcRg = ActiveSheet.UsedRange

'// Use the string returned (the fullname) to Open|Create the .dat file //
Open strFileName For Output As #1
For Each CurrRow In SrcRg.Rows
CurrTextStr = ""
For Each CurrCell In CurrRow.Cells
CurrTextStr = CurrTextStr & CurrCell.Value & ListSep
Next

While Right(CurrTextStr, 1) = ListSep
CurrTextStr = Left(CurrTextStr, Len(CurrTextStr) - 1)
Wend
'Added next line to put | at end of each line
CurrTextStr = CurrTextStr & ListSep
Print #1, CurrTextStr
Next
Close #1
End Sub

Hope that helps,

Mark

[GTO]

BTW - see how much easier your code is to read? I think Aussiebear was nice enough to add the tags and indentation. When posting code, please use the little green and white 'VBA' button atop the reply box. It will add tags to your post, and you can insert the code between the tags.

Mark

[markthomas]

Thanks GTO. Works great.
I have a question though. Instead of bringing up the save as file window, is it possible the macro just saves the file to a location specified by me in the macro? This would makes things easier as I have workbooks with many sheets attached and would not want to choose the location and click save for possibly many sheets in a row.

This forum is great. Its great to see people so willing to help each other out. Great job!

[GTO]

You are most welcome.

You should be able to take what we were using as the InitialFilename and tack ".dat" onto it:


strFileName = Left(ThisWorkbook.Name, _
InStrRev(ThisWorkbook.Name, ".") - 1) & ActiveSheet.Index & ".dat"


Mark

[markthomas]

What we were using has the .dat in it and works fine. I was wondering if I can specify a location in the macro that the file will be saved to? It would also help if the save as dialogue box (where you are asked to confirm the save) does not appear. Is this possible?

[GTO]

Sorry for the delayed response. "Issues" with posting, maybe IE6 related?

Sub test()
Dim SrcRg As Range
Dim CurrRow As Range
Dim CurrCell As Range
Dim CurrTextStr As String
Dim ListSep As String
Dim DataTextStr As String

Dim strFilePath As String
Dim strFileName As String

'// Change path to suit. Retain trailing path seperator. //
strFilePath = ThisWorkbook.Path & "\"

'// If you are using this on other workbooks, and just using the ActiveWorkbook and //
'// ActiveSheet, we'll change where the name comes from. //
'// You'll notice I inserted an underscore, in case you happen to have workbooks //
'// named like Region4.xls or similar. //
strFileName = Left(ActiveWorkbook.Name, _
InStrRev(ActiveWorkbook.Name, ".") - 1) & "_" & ActiveSheet.Index & ".dat"

ListSep = "|"

Set SrcRg = ActiveSheet.UsedRange

'// Use strFilePath and strFileName to Open|Create the .dat file //
Open strFilePath & strFileName For Output As #1
For Each CurrRow In SrcRg.Rows
CurrTextStr = ""
For Each CurrCell In CurrRow.Cells
CurrTextStr = CurrTextStr & CurrCell.Value & ListSep
Next

While Right(CurrTextStr, 1) = ListSep
CurrTextStr = Left(CurrTextStr, Len(CurrTextStr) - 1)
Wend
'Added next line to put | at end of each line
CurrTextStr = CurrTextStr & ListSep
Print #1, CurrTextStr
Next
Close #1
End Sub

Hope that helps,

Mark

[GTO]

Glory be! I've been trying to post from home for a day, nothing over a couple of sentences would take. Suddenly, its back to normal! Anyways, a couple of questions:

You mention a number of workbooks and numerous sheets per book. Is this a daily task?

I ask, as I think we could improve over running the code once per sheet if there are many sheets.

If this is the case, you could post an example wb (substitute fake data for any sensitive) and describe some specifics, such as: (1) are the workbooks in the same folder?, (2) Is a given sheet's data, row-to-row, similar in how many columns are used, etc...

Mark