PeopleSoft Adoption Made Smooth & Simple!
On-The-Job Training Is made Intuitive & Easy With WalkMe's On-Screen Guidance Tool. Claim Your Free WalkMe Account Now
Private Sub SaveAllSheetsAsCSV() On Error GoTo Heaven ' This creates multipls csv files ' each sheet reference Dim Sheet As Worksheet ' path to output to Dim OutputPath As String ' name of each csv Dim OutputFile As String Application.ScreenUpdating = False Application.DisplayAlerts = False Application.EnableEvents = False ' ask the user where to save OutputPath = "C:\temp" If OutputPath <> "" Then ' save for each sheet For Each Sheet In Sheets OutputFile = OutputPath & "\" & Sheet.Name & ".csv" ' make a copy to create a new book with this sheet ' otherwise you will always only get the first sheet Sheet.Copy ' this copy will now become active ActiveWorkbook.SaveAs Filename:=OutputFile, FileFormat:=xlCSV, CreateBackup:=False ActiveWorkbook.Close Next End If Finally: Application.ScreenUpdating = True Application.DisplayAlerts = True Application.EnableEvents = True Exit Sub Heaven: MsgBox "Couldn't save all sheets to CSV." & vbCrLf & "Source: " & Err.Source & " " & vbCrLf & "Number: " & Err.Number & " " & vbCrLf & "Description: " & Err.Description & " " & vbCrLf GoTo Finally Call Wait4Me(50, 1) Call DelSummFile End Sub Public Sub DelSummFile() 'Loop through all the files in the directory by using Dir$ function Dim MyFile As String MyFile = Dir$("c:\temp\Summary.csv") Do While MyFile <> "" KillProperly "c:\temp\" & MyFile 'need to specify full path again because a file was deleted 1 MyFile = Dir$("c:\temp\Summary.csv") Loop End Sub Sub DelFiles() 'Loop through all the files in the directory by using Dir$ function Dim MyFile As String MyFile = Dir$("c:\temp\Sheet*.csv") Do While MyFile <> "" KillProperly "c:\temp\" & MyFile 'need to specify full path again because a file was deleted 1 MyFile = Dir$("c:\temp\sheet*.csv") Loop End Sub Public Sub KillProperly(Killfile As String) If Len(Dir$(Killfile)) > 0 Then SetAttr Killfile, vbNormal Kill Killfile End If End Sub Function Wait4Me(Delay As Integer, DispHrglass As Integer) Dim DelayEnd As Double DoCmd.Hourglass DispHrglass DelayEnd = DateAdd("s", Delay, Now) While DateDiff("s", Now, DelayEnd) > 0 Wend DoCmd.Hourglass False End Function
Add your voice to the tech community where 5M+ people just like you are talking about what matters.
Join the community of 500,000 technology professionals and ask your questions.