Witam wszystkich. Jestem autorką poniższego macro VBA. Od kilku dni próbuję zlokalizować i naprawić swój błąd, niestety bezskutecznie, dlatego zwracam się do Was.
Mam następujące zarzuty w kwestii poniższego kodu:
- w trakcie wyodrębniania i zapisywania kolejnych dokumentów dodawana jest na końcu każdego z nich pusta strona,
- część związana z wyodrębnianiem numeru klienta, który jest potrzebny do nazwy zapisywanych plików nie działa poprawnie, każdy wyodrębniony dokument zostaje zapisany z numerem klienta "000000".
W dokumencie zbiorczym WHITGL0T1.docx fraza "Ntra Ref" znajduje się zawsze na pierwszej stronie każdego z dokumentów do wyodrębnienia natomiast numer klienta pojawia się zawsze w tej samej linijce w której występuje fraza, zaraz za nią i zawsze jest ciągiem 6 cyfr. Niestety w dokumencie WHITGL0T1.docx wygląda to tak: "Ntra Ref : 987654", dlatego podejrzewam, że te spacje i dwukropek mogą stanowić problem, dlatego próbowałam je ominąć. Dodam jeszcze, że ilość spacji, a więc jedna przed dwukropkiem i jedno po dwukropku nie zawsze jest regularna:
Sub SplitDocument()
Dim SourcePath As String
Dim DestinationPath As String
Dim SourceDoc As Document
Dim i As Integer
Dim isDocumentStart As Boolean
Dim docNumber As Integer
Dim startPage As Integer
Dim endPage As Integer
Dim r As Range
Dim startRange As Range
Dim endRange As Range
Dim pageNumbers() As Integer
Dim pageCount As Integer
Dim foundRef As String
Dim clientNumber As String
Dim match As Object
Dim regex As Object
Dim matches As Object
SourcePath = "C:\...\"
DestinationPath = "C:\...\"
docNumber = 0
isDocumentStart = False
Set SourceDoc = Documents.Open(SourcePath & "WHITGL0T1.docx")
Set r = SourceDoc.Range
docNumber = 0
' Inicjalizuj wyrażenie regularne
Set regex = CreateObject("VBScript.RegExp")
regex.IgnoreCase = True
regex.Global = False
regex.Pattern = "Ntra Ref[\s:]*\d{6}" ' Wyrażenie regularne do znalezienia numeru klienta
' Znajdź wszystkie wystąpienia frazy 'Ntra Ref' i zapisz numery stron w tablicy
pageCount = 0
Do While r.Find.Execute(FindText:="Ntra Ref", MatchWholeWord:=True)
pageCount = pageCount + 1
ReDim Preserve pageNumbers(1 To pageCount)
pageNumbers(pageCount) = r.Information(wdActiveEndPageNumber)
Loop
' Dziel dokument na podstawie przechowywanych numerów stron
For i = 1 To pageCount
If Not isDocumentStart Then
Set startRange = SourceDoc.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=pageNumbers(i))
isDocumentStart = True
End If
If i = pageCount Then
Set endRange = SourceDoc.Content
Else
Set endRange = SourceDoc.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=pageNumbers(i + 1))
End If
docNumber = docNumber + 1
endRange.Start = endRange.Start - 1 ' Wykluczenie podziału strony na początku następnej strony
' Zapisz plik z numerem klienta w nazwie
foundRef = SourceDoc.Range(startRange.Start, endRange.End).Text
' Szukaj numeru klienta w tej samej linii
If regex.Test(foundRef) Then
Set matches = regex.Execute(foundRef)
If matches.Count > 0 Then
clientNumber = Trim(Mid(matches(0).Value, InStr(matches(0).Value, " ") + 1, 6))
End If
Else
clientNumber = "000000" ' Zabezpieczenie w przypadku braku numeru
End If
' Zapisz PDF
SourceDoc.Range(startRange.Start, endRange.End).ExportAsFixedFormat2 _
OutputFileName:=DestinationPath & "Document_" & docNumber & "_" & clientNumber & ".pdf", _
ExportFormat:=wdExportFormatPDF
isDocumentStart = False
Next i
SourceDoc.Close SaveChanges:=False
MsgBox "The document has been split into separate documents based on the 'Ntra Ref' criteria and saved in the destination folder.", vbInformation
End Sub
Będę wdzięczna za waszą pomoc!
Pozdrawiam!
