Microsoft Office Forums

Go Back   Microsoft Office Forums > Microsoft Word > Word VBA

Reply
 
LinkBack Thread Tools Display Modes
  #1  
Old 06-02-2016, 09:11 AM
Greengecko Greengecko is offline Windows 7 64bit Office 2010 64bit
Novice
 
Join Date: Sep 2014
Posts: 5
Greengecko is on a distinguished road
Default Import a specific range (bookmarked section) from all Word docs in a selected folder

Hello,
I'm not a VBA programmer; I do know a fair amount of javascript. Is there a way that the above script can be modified to import a specific range (bookmarked section) from all Word docs in a selected folder? I'd greatly appreciate any help. Here's my first attempt at it. What I'm trying to do is select all files in the folder selected by the user, then import all files in that folder, selecting the Range (bookmark) "pmo":


Option Explicit
Sub Importer()
Dim myFolder As String
Dim myFile As String
Dim wdDoc As Document
Dim docmFiles As Document

Application.ScreenUpdating = False

myFolder = openFolder

If myFolder = "" Then Exit Sub

myFile = Dir(myFolder & "\*.docm", vbNormal)
Set wdDoc = ActiveDocument

While myFile <> ""

With Selection.Find.Text = "pmo"
End With
Selection.MoveDown Unit:=wdLine, Count:=1

Set docmFiles = Documents.Open(FileName:=myFolder & "\" & myFile, AddToRecentFiles:=False, Visible:=False, ConfirmConversions:=False)
wdDoc.Range.InsertAfter docmFiles.Range.Bookmarks.Item("pmo") & vbCr
docmFiles.Close SaveChanges:=True




myFile = Dir()
Wend

Set docmFiles = Nothing
Set wdDoc = Nothing

Application.ScreenUpdating = True
End Sub
Function openFolder() As String

Dim oFolder As Object

openFolder = ""

Set oFolder = CreateObject("Shell.Application").BrowseForFolder( 0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then openFolder = oFolder.Items.Item.Path

Set oFolder = Nothing
End Function

Last edited by Greengecko; 06-02-2016 at 09:44 AM. Reason: added VBA script
Reply With Quote
  #2  
Old 06-02-2016, 11:14 PM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 16,660
macropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to behold
Default

For that, you could use a macro like:
Code:
Sub Import_Bookmarked_Text()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, wdDocSrc As Document, wdDocTgt As Document
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc", vbNormal)
Set wdDocTgt = ActiveDocument
While strFile <> ""
  If strFolder & "\" & strFile <> wdDocTgt.FullName Then
  Set wdDocSrc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
  With wdDocSrc
    If .Bookmarks.Exists("pmo") Then
    wdDocTgt.Range.InsertAfter vbCr
    wdDocTgt.Range.Characters.Last.FormattedText = .Bookmarks("pmo").Range.FormattedText
    .Close SaveChanges:=False
  End With
  strFile = Dir()
Wend
Set wdDocSrc = Nothing: Set wdDocTgt = Nothing
Application.ScreenUpdating = True
End Sub
 
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function
PS: When posting code, please use the code tags, indicated by the # button on the posting menu. Without them, your code loses much of whatever structure it had
__________________
Cheers,
Paul Edstein
[MS MVP - Word]
Reply With Quote
  #3  
Old 06-06-2016, 05:52 AM
Greengecko Greengecko is offline Windows 7 64bit Office 2010 64bit
Novice
 
Join Date: Sep 2014
Posts: 5
Greengecko is on a distinguished road
Default Multiple bookmark ranges

Thanks for that, Paul. Now, if I want to insert a couple more bookmark ranges into the same doc, can I just repeat a section of that code and just change the bookmark? My attempt is below, just repeating the "With" section using another bookmark called "int" (thanks for the tip on code tags):

Code:
Sub Import_Bookmarked_Text()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, wdDocSrc As Document, wdDocTgt As Document
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc", vbNormal)
Set wdDocTgt = ActiveDocument
While strFile <> ""
  If strFolder & "\" & strFile <> wdDocTgt.FullName Then
  Set wdDocSrc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
  With wdDocSrc
    If .Bookmarks.Exists("pmo") Then
    wdDocTgt.Range.InsertAfter vbCr
    wdDocTgt.Range.Characters.Last.FormattedText = .Bookmarks("pmo").Range.FormattedText
    .Close SaveChanges:=False
  End With
  With wdDocSrc
    If .Bookmarks.Exists("int") Then
    wdDocTgt.Range.InsertAfter vbCr
    wdDocTgt.Range.Characters.Last.FormattedText = .Bookmarks("int").Range.FormattedText
    .Close SaveChanges:=False
  End With
  strFile = Dir()
Wend
Set wdDocSrc = Nothing: Set wdDocTgt = Nothing
Application.ScreenUpdating = True
End Sub
 
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function
Reply With Quote
  #4  
Old 06-06-2016, 03:30 PM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 16,660
macropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to behold
Default

Yes, you can do that. If there's a lot of bookmarks, I'd probably set up an array of bookmark names and put the With .. End With block into a loop that iterates through the array.
__________________
Cheers,
Paul Edstein
[MS MVP - Word]
Reply With Quote
  #5  
Old 06-14-2016, 07:47 AM
Greengecko Greengecko is offline Windows 7 64bit Office 2010 64bit
Novice
 
Join Date: Sep 2014
Posts: 5
Greengecko is on a distinguished road
Default

How do search for a heading like "PMO Initiatives" in my master doc and just insert the bookmark/range contents at the line just below that? The current script seems to just add all the ranges at the end of the doc.
Reply With Quote
  #6  
Old 06-14-2016, 07:54 AM
Greengecko Greengecko is offline Windows 7 64bit Office 2010 64bit
Novice
 
Join Date: Sep 2014
Posts: 5
Greengecko is on a distinguished road
Default

I should probably explain a little more. I have a doc with four sections:
  • PMO PROJECTS
  • INTERNAL INITIATIVES
  • OPERATIONS & MAINTENANCE
  • ISSUES/RISKS
Then there are 30 or so reports that come from staff that have four matching bookmarks corresponding to each of those section headings. What I need the macro to do is first find the "PMO PROJECTS" heading, go down one line, and insert the "PMO" range from the 30 reports into that section. Then I have to search for "INTERNAL INITIATIVES" go down one line, and insert the "INT" range, and so on. Hope that makes sense.

Code:
Sub Import_Bookmarked_Text()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, wdDocSrc As Document, wdDocTgt As Document
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc", vbNormal)
Set wdDocTgt = ActiveDocument
While strFile <> ""
  If strFolder & "\" & strFile <> wdDocTgt.FullName Then
    Set wdDocSrc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
 
      With wdDocSrc
        If .Bookmarks.Exists("pmo") Then
            ActiveDocument.ActiveWindow.Selection.Find.Text = "PMO PROJECTS"
            Selection.Find.Replacement.ClearFormatting
            Selection.Find.Execute
            Selection.MoveDown Unit:=wdLine, Count:=1
        wdDocTgt.Range.InsertAfter
        wdDocTgt.Range.Characters.Last.FormattedText = .Bookmarks("pmo").Range.FormattedText
        .Close SaveChanges:=False
        End If
      End With
 
 
    ActiveDocument.ActiveWindow.Selection.Find.Text = "INTERNAL INITIATIVES"
    Selection.Find.Execute
    Selection.MoveDown Unit:=wdLine, Count:=1
 
    Set wdDocSrc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
      With wdDocSrc
        If .Bookmarks.Exists("int") Then
        wdDocTgt.Range.InsertAfter vbCr
        wdDocTgt.Range.Characters.Last.FormattedText = .Bookmarks("int").Range.FormattedText
        .Close SaveChanges:=False
        End If
      End With
 
    ActiveDocument.ActiveWindow.Selection.Find.Text = "OPERATIONS & MAINTENANCE"
    Selection.Find.Execute
    Selection.MoveDown Unit:=wdLine, Count:=1
 
    Set wdDocSrc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
      With wdDocSrc
        If .Bookmarks.Exists("ops") Then
        wdDocTgt.Range.InsertAfter vbCr
        wdDocTgt.Range.Characters.Last.FormattedText = .Bookmarks("ops").Range.FormattedText
        .Close SaveChanges:=False
        End If
      End With
 
    ActiveDocument.ActiveWindow.Selection.Find.Text = "ISSUES/RISKS"
    Selection.Find.Execute
    Selection.MoveDown Unit:=wdLine, Count:=1
 
    Set wdDocSrc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
      With wdDocSrc
        If .Bookmarks.Exists("iss") Then
        wdDocTgt.Range.InsertAfter vbCr
        wdDocTgt.Range.Characters.Last.FormattedText = .Bookmarks("iss").Range.FormattedText
        .Close SaveChanges:=False
        End If
      End With
 
  End If
 
  strFile = Dir()
Wend
Set wdDocSrc = Nothing: Set wdDocTgt = Nothing
Application.ScreenUpdating = True
End Sub
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
How to Import range between two string from other document PRA007 Word VBA 1 12-18-2015 09:23 PM
Outlook VBA to move selected email to a public folder aaroncrt Outlook 2 10-21-2013 05:11 PM
Print attachment when it arrive in specific folder with specific subject visha_1984 Outlook 1 01-30-2013 10:42 AM
Returning a specific value when item is selected from a drop-down list J Press Excel 4 09-10-2012 06:12 AM
Printing specific section dfinch Word VBA 2 06-09-2011 05:10 AM


All times are GMT -7. The time now is 03:54 AM.


Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
SEO by vBSEO ©2011, Crawlability, Inc.
MSOfficeForums.com is not affiliated with Microsoft