TM1 Forum

Code: Select all

Sub SaveMultiSheetWorkbookAsCSVFiles()

 Dim path As String
 Dim workbookfilename As String
 Dim count As Integer
 Dim myday, mymonth, myyear As Integer
 Dim workbookname, sheetname, fname As String
 Dim dlgFolderPicker As FileDialog
 
    
    Set dlgFolderPicker = Application.FileDialog(msoFileDialogFolderPicker)
    
    If (dlgFolderPicker.Show() = -1) Then
    
        path = dlgFolderPicker.SelectedItems(1) & "\"
   

        workbookfilename = ActiveWorkbook.Name      ' get the current workbook name so we can switch to it as we save individual worksheets

        i = InStrRev(workbookfilename, ".")
    
        If (i > 1) Then
            workbookname = Left(workbookfilename, i - 1)
        Else
            workbookname = workbookfilename
        End If
    
    
        Windows(workbookfilename).Activate

        count = ActiveWorkbook.Worksheets.count


        myday = Day(Date)

        mymonth = Month(Date)

        myyear = Year(Date)

    
        [b]Application.DisplayAlerts = False[/b]  ' LL Added 2012-05-14
        For i = 1 To count
            ActiveWorkbook.Worksheets(i).Select

            sheetname = ActiveWorkbook.Worksheets(i).Name

            Sheets(sheetname).Copy      ' make a copy of the current worksheet so we can save it.

            fname = path & workbookname & "-" & sheetname & "_" & myyear & "-" & mymonth & "-" & myday & ".csv"
            
            ActiveWorkbook.SaveAs Filename:=fname, FileFormat:=xlCSV, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
            
            ActiveWorkbook.Close False
                        Windows(workbookfilename).Activate  ' switch back to the main workbook

        Next i
        [b]Application.DisplayAlerts = True[/b]    ' LL Added 2012-05-14

    End If
    

End Sub


Public Sub SetTempDirectory()

    frmSetDirectory.Show
End Sub

Code: Select all

Sub SaveMultiSheetWorkbookAsCSVFiles()

    Dim path As String, fname As String, wb As Workbook, dlgFolderPicker As FileDialog

    Set dlgFolderPicker = Application.FileDialog(msoFileDialogFolderPicker)

    If dlgFolderPicker.Show() = -1 Then

        path = dlgFolderPicker.SelectedItems(1) & "\"

        Set wb = ActiveWorkbook

        Application.ScreenUpdating = False

        For i = 1 To wb.Worksheets.count

            With wb.Worksheets(i)
                .Copy      ' make a copy of the current worksheet so we can save it.
                fname = path & Split(workbookfilename & ".", ".")(0) & "-" & .Name & "_" & Format(Date, "yyyy-mm-dd") & ".csv"
                With ActiveWorkbook
                    .SaveAs Filename:=fname, FileFormat:=xlCSV
                    .Saved = True
                    .Close 0
                End With

            End With

        Next

        Application.ScreenUpdating = True

    End If

End Sub

Code: Select all

fname = path & Split(workbookfilename & ".", ".")(0) & "-" & .Name & "_" & Format(Date, "yyyy-mm-dd") & ".csv"

Code: Select all

fname = path & Split(wb.name & ".", ".")(0) & "-" & .Name & "_" & Format(Date, "yyyy-mm-dd") & ".csv"