Excel VBA макрос сохранить как CSV - каждый час - PullRequest
Новая
       32

Excel VBA макрос сохранить как CSV - каждый час

0 голосов
/ 15 октября 2018

Я работаю над простым кодом VBA.У меня есть рабочая книга xlsm с несколькими листами ...

Я хотел бы экспортировать все листы в формате csv каждый час.

Это то, что у меня уже есть (но оно не сохраняется ...) 

Sub ExportSheetsToCSV()
Application.DisplayAlerts = False
Dim xWs As Worksheet
Dim xcsvFile As String
For Each xWs In Application.ActiveWorkbook.Worksheets
    xWs.Copy
    xcsvFile = CurDir & "\" & xWs.Name & ".csv"
    Application.ActiveWorkbook.SaveAs Filename:=xcsvFile, _
    FileFormat:=xlCSV, CreateBackup:=False
    Application.ActiveWorkbook.Saved = True
    Application.ActiveWorkbook.Close
Next
Application.DisplayAlerts = True
Call RefreshDataEachHour
End Sub

В этом модуле workbook: 

Public Sub RefreshDataEachHour()

Application.OnTime Now + TimeValue("01:00:00"), "ExportSheetsToCSV"

End Sub

Когда я удаляю эту строку: Приложение.DisplayAlerts = False экспорт работает отлично, но не каждый час, и я должен проверить «да» в сообщении с подсказкой о формате файла (потеря формул)

Я бы хотел сделать это ...

Ответы [ 2 ]

0 голосов
/ 16 октября 2018

Хорошо,

Код работает отлично ... Просто нужно было быть модулем вместо макроса в ThisWorkbook.

На случай, если кому-то это нужно: просто добавьте модуль и используйтеэтот скрипт: 

Public Sub RefreshDataEachHour()

    Application.OnTime Now + TimeValue("00:00:10"), "Book1.xlsm!ExportSheetsToCSV"

    End Sub
    Sub ExportSheetsToCSV()
    Application.DisplayAlerts = False
    Dim xWs As Worksheet
    Dim xcsvFile As String
    For Each xWs In Application.ActiveWorkbook.Worksheets
        xWs.Copy
        xcsvFile = CurDir & "\" & xWs.Name & ".csv"
        Application.ActiveWorkbook.SaveAs Filename:=xcsvFile, _
        FileFormat:=xlCSV, CreateBackup:=False
        Application.ActiveWorkbook.Saved = True
        Application.ActiveWorkbook.Close
    Next
    Application.DisplayAlerts = True
    Call RefreshDataEachHour
    End Sub
0 голосов
/ 15 октября 2018

Возможно вместо CurDir попробуйте использовать ThisWorkbook.Path.Если вы хотите, чтобы это выполнялось каждый час, и вы также работаете на том же ПК, то CurDir может / изменится в зависимости от того, что вы еще делаете. 

Sub ExportSheetsToCSV()
    Application.DisplayAlerts = False
    Dim xWs As Worksheet, wb As Workbook
    Dim xcsvFile As String
    For Each xWs In Application.ActiveWorkbook.Worksheets
        xWs.Copy
        Set wb = ActiveWorkbook
        xcsvFile = ThisWorkbook.Path & "\" & xWs.Name & ".csv"
        wb.SaveAs Filename:=xcsvFile, _
            FileFormat:=xlCSV, CreateBackup:=False
        wb.Close False 'don't save
    Next
    Application.DisplayAlerts = True
    Call RefreshDataEachHour
End Sub
...