Блог

Решено, спасибо

У меня есть макросы, которые создают файлы экспорта для наших данных. Мы создаем много файлов каждый день, поэтому я пытаюсь настроить несколько вещей.

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

Примеры имен файлов в папке:

B001 Экспорт имени клиента 051121

B002 Экспорт имени клиента 091121

B003 Экспорт имени клиента 101121

Есть ли какой-либо способ автоматизировать добавочное число? Используйте 1 для наибольшего значения.

Затем следующий файл будет сохранен как Экспорт имени клиента B004 <сегодняшняя дата>

Мне удалось заполнить окно сообщения, в котором отображается текущее наибольшее число, моя трудность заключается в том, чтобы использовать это для сохранения документа со следующим номером

 Option Explicit

Public Sub Example()
Const FolderPath = "Z:"
Const FileExt = "xlsx"
Debug.Print GetNextFileNum(FolderPath, FileExt)
End Sub

Public Function GetNextFileNum(ByVal TargetFolder As String, ByVal Extension As String) As Integer
Dim Folder As Object, File As Object

With CreateObject("Scripting.FileSystemObject")
    Set Folder = .GetFolder(TargetFolder)
    For Each File In Folder.Files
        If IsNumeric(Mid(File.Name, 2, 3)) And FileExt(File.Name) = Extension Then
            GetNextFileNum = IIf(CInt(Mid(File.Name, 2, 3)) > GetNextFileNum, CInt(Mid(File.Name, 2, 3)), GetNextFileNum)
        End If
    Next File
End With

GetNextFileNum = GetNextFileNum   1

  ActiveWorkbook.SaveAs Filename:= _
    "Z:" amp; "F00" amp; GetNextFileNum amp; " 
One " amp; _
    Format(Date, "ddmmyy") amp; ".xlsx" _
    , FileFormat:=xlOpenXMLStrictWorkbook, CreateBackup:=False

End Function

Public Function FileExt(ByVal Path As String) As String
With CreateObject("Scripting.FileSystemObject"): FileExt = .GetExtensionName(Path): End With
End Function
 

Тоби.

Вы можете попробовать что-то вроде этого.

 Sub LoopThroughFiles()
 
Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim i As Integer
 
Set oFSO = CreateObject("Scripting.FileSystemObject")
AcFolder = ActiveWorkbook.Path
 
Set oFolder = oFSO.GetFolder(AcFolder)
 
Bigger = 0
 
For Each oFile In oFolder.Files
    If Left(oFile.Name, 1) = "B" Then
       If CInt(Mid(oFile.Name, 2, 3)) > Bigger Then
          Bigger = CInt(Mid(oFile.Name, 2, 3))
       End If
    End If
Next oFile
    
    NextNumber = Bigger   1
    MsgBox NextNumber
     
End Sub