- Increase transparency
- Onboard new hires faster
- Access from mobile/offline
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
|Powershell script to pull Info from all server within a domain||4||35|
|Excel: How would I make a depleting dropdown list that shows only values that havent been chosen before?||4||52|
|Create image with transparent background for selected content in MS Excel or Word||5||22|
|Index Match not working on second pass||7||0|
Join the community of 500,000 technology professionals and ask your questions.
Connect with top rated Experts
10 Experts available now in Live!