VBA L oop через файлы в каталоге, сохранить как csv в другом каталоге, пропустить, если файл существует - PullRequest
Новая
       18

VBA L oop через файлы в каталоге, сохранить как csv в другом каталоге, пропустить, если файл существует

0 голосов
/ 14 апреля 2020

У меня есть немного кода, который просматривает кучу файлов в папке, запускает макрос для каждого из них, а затем сохраняет их как файл .csv в другой папке. Процесс работает нормально, если папка csv назначения пуста. Что я хочу сделать, это пропустить процесс, если файл .csv уже существует. Проблема с кодом ниже состоит в том, что Filename = Dir () возвращает нулевое значение, и l oop заканчивается, если файл .csv существует. Итак, как мне продолжить просмотр других файлов в первой папке? 

Sub ProcessFiles()
Dim Filename, Pathname, strFileExists As String
Dim wb As Workbook

Application.ScreenUpdating = False

Pathname = ActiveWorkbook.Path & "\Files\"
Filename = Dir(Pathname & "*.xlsx")
Do While Filename <> ""
    Set wb = Workbooks.Open(Pathname & Filename)
    length = Len(ActiveWorkbook.Name)
    Name = Left(ActiveWorkbook.Name, length - 5)
    CSVName = ActiveWorkbook.Path & "\CSV Files\" & Name & ".csv"
    strFileExists = Dir(CSVName)

    If strFileExists = "" Then
        Transform wb 'Run Transform function
        wb.SaveAs Filename:=CSVName, FileFormat:=xlCSVMSDOS, CreateBackup:=False
        wb.Close SaveChanges:=False
        Filename = Dir()
    Else
        wb.Close SaveChanges:=False
        Filename = Dir()
    End If
Loop
End Sub

1 Ответ

1 голос
/ 15 апреля 2020

Я думаю, что braX прав: проблема в том, что вы используете Dir дважды. Кажется, это работает для меня: 

Sub ProcessFiles()
    Dim Filename, Pathname, strFileExists As String
    Dim wb As Workbook
    Dim IntFileNumber As Integer
    Dim IntCounter01 As Integer
    Dim Length As Byte
    Dim Name As String
    Dim CSVName As String

    Application.ScreenUpdating = False

    Pathname = ActiveWorkbook.Path & "\Files\"
    Filename = Dir(Pathname & "*.xlsx")

    Do While Filename <> ""
        Set wb = Workbooks.Open(Pathname & Filename)
        Length = Len(ActiveWorkbook.Name)
        Name = Left(ActiveWorkbook.Name, Length - 5)
        CSVName = ActiveWorkbook.Path & "\CSV Files\" & Name & ".csv"
        strFileExists = Dir(CSVName)


        If strFileExists = "" Then
            Transform wb 'Run Transform function
            wb.SaveAs Filename:=CSVName, FileFormat:=xlCSVMSDOS, CreateBackup:=False
            wb.Close SaveChanges:=False
            Filename = Dir(Pathname & "*.xlsx")
            IntFileNumber = IntFileNumber + 1
            For IntCounter01 = 1 To IntFileNumber
                Filename = Dir()
            Next
        Else
            wb.Close SaveChanges:=False
            Filename = Dir(Pathname & "*.xlsx")
            IntFileNumber = IntFileNumber + 1
            For IntCounter01 = 1 To IntFileNumber
                Filename = Dir()
            Next
        End If
    Loop

End Sub

По сути, я сбрасываю имя файла и переигрываю Dir столько раз, сколько необходимо для достижения требуемого файла.

Я добавил несколько объявлений тоже. Возможно, вы также захотите установить истинное значение ScreenUpdating в конце подпрограммы, но это ваше дело.

...