Help modify code to split & save document at section breaks
-
- Administrator
- Posts: 78595
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Help modify code to split & save document at section breaks
I understand that, but the document does not consist of ordinary paragraphs. Most lines of text are in frames, and the piece of text that is in Frame #10 in one part is in Frame #11 in another part, so there is no consistent way of finding out which frame contains the name of the trade union.
Best wishes,
Hans
Hans
-
- StarLounger
- Posts: 94
- Joined: 10 Oct 2022, 02:52
Re: Help modify code to split & save document at section breaks
Dear Hans,
Since the doc file is large, I remove the part of the document before uploading. I think that is why the format has changed. Re-update the file and it works for Frame #10.
Thanks,
Regarding,
Priyantha
Since the doc file is large, I remove the part of the document before uploading. I think that is why the format has changed. Re-update the file and it works for Frame #10.
Thanks,
Regarding,
Priyantha
You do not have the required permissions to view the files attached to this post.
-
- Administrator
- Posts: 78595
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Help modify code to split & save document at section breaks
Try this:
Code: Select all
Sub Split_Thirdparty_Letters_pdf()
Dim xlApp As Object
Dim xlWbk As Object
Dim xlWsh As Object
Dim xlRng As Object
Dim lngStart As Long
Dim lngEnd As Long
Dim lngDocNum As Long
Dim docOld As Document
Dim docNew As Document
Dim sText As String
Dim sTotal As String
Dim sDirectory As String
On Error Resume Next
Set xlApp = GetObject(Class:="Excel.Application")
If xlApp Is Nothing Then
Set xlApp = CreateObject(Class:="Excel.Application")
End If
On Error GoTo 0
' Add path to workbook if necessary
Set xlWbk = xlApp.Workbooks.Open("Thirdparty Remitance.xlsm")
Set xlWsh = xlWbk.Worksheets(1)
Set docOld = ActiveDocument
lngStart = 1
Selection.HomeKey Unit:=wdStory
With Selection.Find
.ClearFormatting
.Text = "Grand *^12"
.MatchWildcards = True
.Wrap = wdFindStop
Do While .Execute
Selection.Collapse Direction:=wdCollapseEnd
lngEnd = Selection.End
' Copy the "section"
docOld.Range(lngStart, lngEnd - 1).Copy
'Create a new document to paste text from clipboard.
Set docNew = Documents.Add
Selection.Paste
lngDocNum = lngDocNum + 1
'''Convert to PDF'''
sText = docNew.Frames(10).Range.Text
sDirectory = "C:\Users\User\Desktop\Thirdparty Payments\Thirdparty Letters\"
sTotal = docNew.Frames(21).Range.Text
Set xlRng = xlWsh.Range("F:F").Find(What:=sText, LookAt:=1, MatchCase:=False)
If Not xlRng Is Nothing Then
xlRng.Offset(0, 1).Value = Val(sTotal)
End If
'docNew.ExportAsFixedFormat OutputFileName:=sDirectory & Trim(sText) & ".pdf", ExportFormat:=17
docNew.Close SaveChanges:=False ''close the new document'''
' set new start
lngStart = lngEnd + 1
Loop
End With
' Last part
Selection.Collapse Direction:=wdCollapseEnd
lngEnd = ActiveDocument.Content.End
' Copy the "section"
docOld.Range(lngStart, lngEnd - 1).Copy
'Create a new document to paste text from clipboard.
Set docNew = Documents.Add
Selection.Paste
' Save the new document
lngDocNum = lngDocNum + 1
'''Convert to PDF'''
sText = docNew.Frames(10).Range.Text
sTotal = docNew.Frames(21).Range.Text
Set xlRng = xlWsh.Range("F:F").Find(What:=sText, LookAt:=1, MatchCase:=False)
If Not xlRng Is Nothing Then
xlRng.Offset(0, 1).Value = Val(sTotal)
End If
docNew.ExportAsFixedFormat OutputFileName:=sDirectory & Trim(sText) & ".pdf", ExportFormat:=17
docNew.Close SaveChanges:=False ''close the new document'''
xlWbk.Close SaveChanges:=True
End Sub
Best wishes,
Hans
Hans
-
- 4StarLounger
- Posts: 508
- Joined: 17 Dec 2010, 03:14
Re: Help modify code to split & save document at section breaks
Seems there's a lot of wheel reinventing going on here.
For documents being created via mailmerge, see Send Mailmerge Output to Individual Files and Run a Mailmerge from Excel, Sending the Output to Individual Files in the Mailmerge Tips and Tricks page at: https://www.msofficeforums.com/mail-mer ... ricks.html. The code there shows how to go about producing the individual documents from the mailmerge itself, without having to split the output afterwards.
Similarly, for existing documents that might have been generated by a mailmerge, see Split Merged Output to Separate Documents on the same page. Such documents don't necessarily have to have been produced by a mailmerge. What the code there allows for - unlike most document splitters - is for the existence of multiple Sections per output document to be extracted from the input document.
For documents being created via mailmerge, see Send Mailmerge Output to Individual Files and Run a Mailmerge from Excel, Sending the Output to Individual Files in the Mailmerge Tips and Tricks page at: https://www.msofficeforums.com/mail-mer ... ricks.html. The code there shows how to go about producing the individual documents from the mailmerge itself, without having to split the output afterwards.
Similarly, for existing documents that might have been generated by a mailmerge, see Split Merged Output to Separate Documents on the same page. Such documents don't necessarily have to have been produced by a mailmerge. What the code there allows for - unlike most document splitters - is for the existence of multiple Sections per output document to be extracted from the input document.
Paul Edstein
[Fmr MS MVP - Word]
[Fmr MS MVP - Word]
-
- Administrator
- Posts: 78595
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Help modify code to split & save document at section breaks
The document being discussed in recent replies in this thread is horrible - it appears to be some kind of report that has been converted to PDF and then converted into Word. The result consists of lots of frames...
Best wishes,
Hans
Hans
-
- 4StarLounger
- Posts: 508
- Joined: 17 Dec 2010, 03:14
Re: Help modify code to split & save document at section breaks
Here's a macro I wrote some years ago for cleaning up such documents.
Basically, it simply relocates the content to wherever the shapes where anchored. It seemed to work OK on that occasion. Maybe it will help here, too. Whether it positions the output correctly depends on where the textboxes are anchored; if the anchor positions are unrelated to the textbox locations, one will end up with a dog's breakfast. Even when that’s not the case, the document will probably still also end up with each line as its own paragraph. To clean up such content, see: https://www.msofficeforums.com/word/298 ... mails.html.
Code: Select all
Sub EraseTextBoxes()
Dim RngDoc As Range, RngShp As Range, i As Long
With ActiveDocument
For i = .Shapes.Count To 1 Step -1
With .Shapes(i)
If .Type = msoTextBox Then
Set RngShp = .TextFrame.TextRange
RngShp.End = RngShp.End - 1
Set RngDoc = .Anchor
RngDoc.Collapse wdCollapseEnd
RngDoc.FormattedText = RngShp.FormattedText
.Delete
End If
End With
Next
End With
End Sub
Paul Edstein
[Fmr MS MVP - Word]
[Fmr MS MVP - Word]
-
- Administrator
- Posts: 78595
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Help modify code to split & save document at section breaks
Hi Paul, that macro doesn't help here, since the document consists of frames instead of text boxes. Since a Frame doesn't have an anchor, I can't adapt the code for frames.
Best wishes,
Hans
Hans
-
- StarLounger
- Posts: 94
- Joined: 10 Oct 2022, 02:52
Re: Help modify code to split & save document at section breaks
Dear Hans,
I tried & worked correctly, thanks, Hans. But you defined the grand total to Frames (21) ( sTotal = docNew.Frames(21).Range.Text) and it works for one page. Some files consist of several pages, and the last page includes the Grand Total.
Otherwise, when a new union name met creating files that are not in the range (Set xlRng = xlWsh.Range("F:F").Find(What:=sText, LookAt:=1, MatchCase:=False), it can be displayed by a message.
Thanks,
Regarding,
Priyantha.
I tried & worked correctly, thanks, Hans. But you defined the grand total to Frames (21) ( sTotal = docNew.Frames(21).Range.Text) and it works for one page. Some files consist of several pages, and the last page includes the Grand Total.
Otherwise, when a new union name met creating files that are not in the range (Set xlRng = xlWsh.Range("F:F").Find(What:=sText, LookAt:=1, MatchCase:=False), it can be displayed by a message.
Thanks,
Regarding,
Priyantha.
-
- Administrator
- Posts: 78595
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Help modify code to split & save document at section breaks
Once again - the document is inconsistent. I cannot solve that.But you defined the grand total to Frames (21) ( sTotal = docNew.Frames(21).Range.Text) and it works for one page. Some files consist of several pages, and the last page includes the Grand Total.
Best wishes,
Hans
Hans
-
- StarLounger
- Posts: 94
- Joined: 10 Oct 2022, 02:52
Re: Help modify code to split & save document at section breaks
Dear Hans,
Thanks for your help.
regarding,
priyantha
Thanks for your help.
regarding,
priyantha
-
- 4StarLounger
- Posts: 508
- Joined: 17 Dec 2010, 03:14
Re: Help modify code to split & save document at section breaks
You would probably do better to work with the original PDF and parse its data directly into Excel or to a text file that can be imported into Excel as a CSV file. For an idea of what can be done, see:
https://www.msofficeforums.com/excel-pr ... excel.html
https://www.msofficeforums.com/excel-pr ... -file.html
https://www.msofficeforums.com/excel-pr ... excel.html
https://www.msofficeforums.com/excel-pr ... -file.html
Paul Edstein
[Fmr MS MVP - Word]
[Fmr MS MVP - Word]
-
- StarLounger
- Posts: 94
- Joined: 10 Oct 2022, 02:52
Re: Help modify code to split & save document at section breaks
Dear Paul Edstein,
Thanks, I'll see.
Regarding,
Priyantha
Thanks, I'll see.
Regarding,
Priyantha
-
- StarLounger
- Posts: 94
- Joined: 10 Oct 2022, 02:52
Re: Help modify code to split & save document at section breaks
Dear Hans,
My problem above still could not be solved. I hope your help again. Can I find the index number of a frame (Eg. Frame(20)) that included a specific word (Like Gand total). If it can be found, is there a possibility to get the grand total Value to a variable by adding a specific value to that value?
Thanks,
Priyantha
My problem above still could not be solved. I hope your help again. Can I find the index number of a frame (Eg. Frame(20)) that included a specific word (Like Gand total). If it can be found, is there a possibility to get the grand total Value to a variable by adding a specific value to that value?
Thanks,
Priyantha
-
- Administrator
- Posts: 78595
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Help modify code to split & save document at section breaks
Try this:
Code: Select all
Sub Split_Thirdparty_Letters_pdf()
Dim xlApp As Object
Dim xlWbk As Object
Dim xlWsh As Object
Dim xlRng As Object
Dim lngStart As Long
Dim lngEnd As Long
Dim lngDocNum As Long
Dim docOld As Document
Dim docNew As Document
Dim sText As String
Dim sTotal As String
Dim sDirectory As String
Dim i As Long
On Error Resume Next
Set xlApp = GetObject(Class:="Excel.Application")
If xlApp Is Nothing Then
Set xlApp = CreateObject(Class:="Excel.Application")
End If
On Error GoTo 0
sDirectory = "C:\Users\User\Desktop\Thirdparty Payments\Thirdparty Letters\"
' Add path to workbook if necessary
Set xlWbk = xlApp.Workbooks.Open("Thirdparty Remitance.xlsm")
Set xlWsh = xlWbk.Worksheets(1)
Set docOld = ActiveDocument
lngStart = 1
Selection.HomeKey Unit:=wdStory
With Selection.Find
.ClearFormatting
.Text = "Grand *^12"
.MatchWildcards = True
.Wrap = wdFindStop
Do While .Execute
Selection.Collapse Direction:=wdCollapseEnd
lngEnd = Selection.End
' Copy the "section"
docOld.Range(lngStart, lngEnd - 1).Copy
'Create a new document to paste text from clipboard.
Set docNew = Documents.Add
Selection.Paste
lngDocNum = lngDocNum + 1
'''Convert to PDF'''
sText = docNew.Frames(10).Range.Text
For i = 1 To docNew.Frames.Count
If docNew.Frames(i).Range.Text = "Grand Total" Then
sTotal = docNew.Frames(i + 1).Range.Text
Exit For
End If
Next i
Set xlRng = xlWsh.Range("F:F").Find(What:=sText, LookAt:=1, MatchCase:=False)
If Not xlRng Is Nothing Then
xlRng.Offset(0, 1).Value = Val(sTotal)
End If
docNew.ExportAsFixedFormat OutputFileName:=sDirectory & Trim(sText) & ".pdf", ExportFormat:=17
docNew.Close SaveChanges:=False ''close the new document'''
' set new start
lngStart = lngEnd + 1
Loop
End With
' Last part
Selection.Collapse Direction:=wdCollapseEnd
lngEnd = ActiveDocument.Content.End
' Copy the "section"
docOld.Range(lngStart, lngEnd - 1).Copy
'Create a new document to paste text from clipboard.
Set docNew = Documents.Add
Selection.Paste
' Save the new document
lngDocNum = lngDocNum + 1
'''Convert to PDF'''
sText = docNew.Frames(10).Range.Text
For i = 1 To docNew.Frames.Count
If docNew.Frames(i).Range.Text = "Grand Total" Then
sTotal = docNew.Frames(i + 1).Range.Text
Exit For
End If
Next i
Set xlRng = xlWsh.Range("F:F").Find(What:=sText, LookAt:=1, MatchCase:=False)
If Not xlRng Is Nothing Then
xlRng.Offset(0, 1).Value = Val(sTotal)
End If
docNew.ExportAsFixedFormat OutputFileName:=sDirectory & Trim(sText) & ".pdf", ExportFormat:=17
docNew.Close SaveChanges:=False ''close the new document'''
xlWbk.Close SaveChanges:=True
End Sub
Best wishes,
Hans
Hans
-
- 4StarLounger
- Posts: 508
- Joined: 17 Dec 2010, 03:14
Re: Help modify code to split & save document at section breaks
Cross-posted at: https://www.msofficeforums.com/word-vba ... g-vba.html
Please read Eileen's Lounge's policy on Cross-Posting in item 9 of the rules: http://www.eileenslounge.com/viewtopic.php?f=11&t=488
Please read Eileen's Lounge's policy on Cross-Posting in item 9 of the rules: http://www.eileenslounge.com/viewtopic.php?f=11&t=488
Paul Edstein
[Fmr MS MVP - Word]
[Fmr MS MVP - Word]
-
- StarLounger
- Posts: 94
- Joined: 10 Oct 2022, 02:52
Re: Help modify code to split & save document at section breaks
Dear Paul Edstein,
Actually I was not aware of that. I apologize to all of you in the forum.
Regading
Priyantha
Actually I was not aware of that. I apologize to all of you in the forum.
Regading
Priyantha
-
- StarLounger
- Posts: 94
- Joined: 10 Oct 2022, 02:52
Re: Help modify code to split & save document at section breaks
Dear Hans,
Your code is working corecly. Thank you very much for your time and knowledge to make my work easier.
Thanks,
Priyantha
Your code is working corecly. Thank you very much for your time and knowledge to make my work easier.
Thanks,
Priyantha