Excel DisplayAlerts

[kwakkers]

Hello everyone

We have some vb code that saves all the tm1 sheets in a file into csv files. Upto now the user had been manually clicking on OK to save the sheets. I thought I could change this by turning off displayalerts as part of the process.

This works just fine when I am not connected to TM1, but it seems to ignore it when connected (and the user had to click ok for every save). Could anyone offer a potential cause and solution? Any help would be appreciated.

The code I have is:

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

[Wim Gielis]

Hello kwakkers

I bet this will be a lot better code and more readable code:

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

[kwakkers]

Hi Wim

You solution worked an absolute treat, and is definitely more readable. There was a slight issue with the code in regards to the filename as workbookfilename returned an empty string

Code: Select all

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

I used to return what the users wanted.

Code: Select all

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

Thank you so much for your help, it is greatly appreciated.

[Wim Gielis]

You're welcome, glad it helps.