PDA

View Full Version : Solved: Auto Save as help



bacon
02-10-2006, 05:09 AM
Hello

I would like a copy of a spreadsheet saved as a csv using the following metholodgy... data_472_20060209_1830.csv. Quite simple this will be static text "data_472_" followed by the year "2006", month "02" then day "09" followed by an underscore then followed by the time "1830".csv

The current VBA i am using simply saves the file as static text..(see below)

Can anyone help with amending the below VBA to save the spreadsheet as a CSV using the above metholodgy??

Thanks in advance


Private Function WriteFile(Range As Range, Index As Integer) As String

Dim sFile As String
Dim nFile As Integer
Dim nPage As Integer
Dim bFirstFile As Boolean

sFile = "c:\swapsstrips.xls"
nFile = FreeFile
Open sFile For Output As #nFile

bFirstFile = True
For nPage = 1 To Range.Columns.Count - 2
If UCase(Left(Range.Cells(Index + 1, nPage + 1).Value, 1)) = "Y" Then
If bFirstFile Then
bFirstFile = False
Else
Print #nFile, ""
Print #nFile, ""
End If
WriteRange nFile, Application.Range(CStr("Page" & nPage))
End If
Next nPage

Close #nFile

WriteFile = sFile

XLGibbs
02-10-2006, 10:34 AM
Something like this would seem to work for you...


Sub SaveasCSV()
Dim sFile as Workbook,strFileName as string

Application.DisplayAlerts = False
Set sFile =Workbooks.Open("C:\swapstrips.xls")
strFilename = "data_472_" & Format(now(),"yyyymmdd_hhmm")

With ActiveWorkbook
.Saveas strFileName,xlCSV
.Close False
End With

Application.DisplayAlerts = True
Set sFile = nothing
End Sub


Hope that helps...do you need to email this as well based on this
http://vbaexpress.com/forum/showthread.php?t=6944

from that post...my guess is you could modify this part of that post to email the file...

On Error Resume Next
Set OL = GetObject(, "Outlook.Application")
If Err <> 0 Then
Set OL = CreateObject("Outlook.Application")
IsCreated = True
End If
Set OLmsg = OL.CreateItem(olMailItem)
OLmsg.To = "ToSomeobdy@TheirDomain.com"
OLmsg.Subject = ""
OLmsg.Attachments.Add strKillPath
OLmsg.Display

Kill strKillPath
If IsCreated Then OL.Quit

Set OL = Nothing
Set OLmsg = Nothing
Set wb = Nothing

Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True

bacon
02-13-2006, 03:40 AM
THANK YOU :)

geekgirlau
02-13-2006, 09:51 PM
Bacon, don't forget to mark this thread as "Solved" by using the Thread Tools at the top of the page.