Copy from Word and paste into Excel the name address and invoice number

Hi,

I'm trying to copy company names, addresses (both street and email) and other information from a series of word documents into a single excel spreadsheet.  This task seems somewhat similar to what is been done before, but I'm not sure if its merely relabeling file and folder names that would be required.

First, I have a folder on my computer called "customer", and in this folder there are other customer folders named "Mike Raphone", "Pat Metheny" and so on.  Within each named customer folder, there is a word document  with the information in it as in the attached "word doc info.jpeg"

What I'd like to have done is to have a macro or something that would go through all the customer folders in word, open the word documents therein, cut the company name, address, phone , email address(es), Invoice number and invoice date, and total service value pasted into the corresponding columns in the attached spreadsheet.  The "service start date" in column T on the spreadsheet corresponds to the "service period" date in the jpeg as well.


Ideally, the macro or code should use the appliance number on the excel spreadsheet to match information on the "reference" box in the jpeg.  I hope this is clear.

Thanks for any help you can provide.
word-doc-info.JPG
131011-tot-box-test-sheet-v1.5.xlsx
RugoingwmeAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

MacroShadowCommented:
Please supply the word doc, it is impossible to do what you ask without knowing the structure of the document.
0
RugoingwmeAuthor Commented:
I've attached the word document.  Also, any suggestions on how either the word doc or excel spreadsheet should be formatted to make your job easier are welcome.
131015-word-excel-invoice-test.docx
0
FaustulusCommented:
You wrote
Within each named customer folder, there is a word document
How can this document be identified?
1. Is it the only Word document in the folder?
2. Does it have a generic name that can be constructed from the folder (customer's) name?
0
Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

RugoingwmeAuthor Commented:
Sorry for the late reply, I thought no one was interested in trying to address this.  There is a folder in the directory with the name of each customer.  the Directory format is like this

e;\SONY\Umbra\Organization\customers\Wes Montgomery
 
Within the Wes Montgomery folder, there are 2 or sometime 3 or 4 word documents that are named using the following convention:

yy/mm/dd - Invoice - UMB-INV-001-13 - 000XXX,

In this example the invoice word document might be

130910 - invoice - UMB-INV-001-13-000329.doc
130610 - invoice - UMB-INV-001-13-000151.doc
130104 - invoice - UMB-INV-001-13-000071.doc

Hopefully that is clear. Let me know if there are other questions.  Thanks!
0
FaustulusCommented:
Your requirement looks clear, for now. But there is a new question which has just been popped by your reply. What is the environment?
Which version of Excel do you have? Which version of Word? And in which version of Word were the invoice files created? Is it possible that both, DOC and DOCX formats, will be encountered?
And, yes, there is one more other question. Will this be a one-off operation? Or do you intend to run the program repeatedly, for instance, in order to add new customers to an already existing list?
0
RugoingwmeAuthor Commented:
to answer your questions:

1. I'm on Windows 7, 64-bit
2. I have Excel 2013
3. Word 2013
4. Word documents are created in word 2013 and word 2007.  There are likely also word documents saved to the 2003 format, so yes, likely DOC and DOCX files will be encountered.
5. Yes, i'll likely run this repeatedly to include invoices for new customers as they are generated. and it will be the existing directory as mentioned above where the new customer names will be added.
0
MacroShadowCommented:
I thought no one was interested in trying to address this

By all means I had intended to answer this, unfortunately time is quite tight lately, if you know what I mean.

Anyhow, you can try this (not tested but looks promising).

1. Recreate your word document (a new file), following these guidelines:
     a) Create two separate tables (table #1: 8 rows, 5 columns. table #2: 5 rows, 6 columns). The layout doesn't matter.
     b) Do NOT split or merge any cells.
2. Copy the following to a new module:
Option Explicit

Sub Demo()

    Dim oWord As Object
    Dim oDoc As Object
    Dim strPath As String
    Dim strFile As String
    Dim lngStartingRow As Long

    Set oWord = CreateObject("Word.Application")
    oWord.Visible = False
    strPath = "C:\Users\The Raiton Family\Downloads"

    If Right(strPath, 1) <> "\" Then strPath = strPath & "\"

    strFile = Dir(strPath & "*.docx")

    Set oDoc = oWord.Documents.Open(strPath & strFile)
    
    lngStartingRow = ActiveWorkbook.Worksheets(1).Range("D" & Rows.Count).End(xlDown).End(xlUp).Offset(1, 0).Row + 1  'starting row
'    lngStartingRow = Columns("A:A").SpecialCells(xlCellTypeBlanks)(1, 1).Row

    Cells(lngStartingRow, 4).Value = Left(oDoc.Tables(1).Rows(2).Cells(2).Range.Text, Len(oDoc.Tables(1).Rows(2).Cells(2).Range.Text) - 2)     ' company name
    Cells(lngStartingRow, 5).Value = Left(oDoc.Tables(1).Rows(3).Cells(2).Range.Text, Len(oDoc.Tables(1).Rows(3).Cells(2).Range.Text) - 2)     ' address
    Cells(lngStartingRow, 6).Value = Left(oDoc.Tables(1).Rows(4).Cells(2).Range.Text, Len(oDoc.Tables(1).Rows(4).Cells(2).Range.Text) - 2)     ' phone
    Cells(lngStartingRow, 11).Value = Left(oDoc.Tables(1).Rows(7).Cells(2).Range.Text, Len(oDoc.Tables(1).Rows(7).Cells(2).Range.Text) - 2)    ' email address(es)
    Cells(lngStartingRow, 19).Value = Left(oDoc.Tables(1).Rows(5).Cells(5).Range.Text, Len(oDoc.Tables(1).Rows(5).Cells(5).Range.Text) - 2)    ' Invoice number
    Cells(lngStartingRow, 18).Value = Left(oDoc.Tables(1).Rows(6).Cells(5).Range.Text, Len(oDoc.Tables(1).Rows(6).Cells(5).Range.Text) - 2)    ' invoice date
    Cells(lngStartingRow, 15).Value = Left(oDoc.Tables(2).Rows(4).Cells(6).Range.Text, Len(oDoc.Tables(2).Rows(4).Cells(6).Range.Text) - 2)    ' total service value
    Cells(lngStartingRow, 13).Value = Left(oDoc.Tables(2).Rows(2).Cells(2).Range.Text, Len(oDoc.Tables(2).Rows(2).Cells(2).Range.Text) - 2)    ' service start date=service period
    Cells(lngStartingRow, 2).Value = Left(oDoc.Tables(1).Rows(8).Cells(5).Range.Text, Len(oDoc.Tables(1).Rows(8).Cells(5).Range.Text) - 2)     ' reference=appliance number

    oDoc.Close SaveChanges:=False
    oWord.Quit
    Set oWord = Nothing

End Sub


Sub ProcessFiles()

    ' Variables for the looping
    Dim strFolder As String
    Dim strFileName As String
    Dim strFolders() As String
    Dim iFolderCount As Integer
    Dim i As Integer
    
    ' Variables for the actual processing of files
    Dim oWord As Object
    Dim oDoc As Object
    Dim lngStartingRow As Long

    'Collect child folders and add to array
    
    strFolder = "E:\SONY\Umbra\Organization\customers\Wes Montgomery"
    If Right(strFolder, 1) <> "\" Then strFolder = strFolder & "\"
    strFileName = Dir$(strFolder, vbDirectory)
    Do Until strFileName = ""
        If (GetAttr(strFolder & "\" & strFileName) And vbDirectory) = vbDirectory Then
            If Left$(strFileName, 1) <> "." Then
                ReDim Preserve strFolders(iFolderCount)
                strFolders(iFolderCount) = strFolder & "\" & strFileName
                iFolderCount = iFolderCount + 1
            End If
        End If
        strFileName = Dir$()
    Loop

    'process files in current folder
    strFileName = Dir$(strFolder & "\" & "*.doc*")
    Do Until strFileName = ""
        Set oWord = CreateObject("Word.Application")
        oWord.Visible = False

        Set oDoc = oWord.Documents.Open(strFolder & strFileName)

        lngStartingRow = ActiveWorkbook.Worksheets(1).Range("D" & Rows.Count).End(xlDown).End(xlUp).Offset(1, 0).Row + 1  'starting row
        '    lngStartingRow = Columns("A:A").SpecialCells(xlCellTypeBlanks)(1, 1).Row

        Cells(lngStartingRow, 4).Value = Left(oDoc.Tables(1).Rows(2).Cells(2).Range.Text, Len(oDoc.Tables(1).Rows(2).Cells(2).Range.Text) - 2)     ' company name
        Cells(lngStartingRow, 5).Value = Left(oDoc.Tables(1).Rows(3).Cells(2).Range.Text, Len(oDoc.Tables(1).Rows(3).Cells(2).Range.Text) - 2)     ' address
        Cells(lngStartingRow, 6).Value = Left(oDoc.Tables(1).Rows(4).Cells(2).Range.Text, Len(oDoc.Tables(1).Rows(4).Cells(2).Range.Text) - 2)     ' phone
        Cells(lngStartingRow, 11).Value = Left(oDoc.Tables(1).Rows(7).Cells(2).Range.Text, Len(oDoc.Tables(1).Rows(7).Cells(2).Range.Text) - 2)    ' email address(es)
        Cells(lngStartingRow, 19).Value = Left(oDoc.Tables(1).Rows(5).Cells(5).Range.Text, Len(oDoc.Tables(1).Rows(5).Cells(5).Range.Text) - 2)    ' Invoice number
        Cells(lngStartingRow, 18).Value = Left(oDoc.Tables(1).Rows(6).Cells(5).Range.Text, Len(oDoc.Tables(1).Rows(6).Cells(5).Range.Text) - 2)    ' invoice date
        Cells(lngStartingRow, 15).Value = Left(oDoc.Tables(2).Rows(4).Cells(6).Range.Text, Len(oDoc.Tables(2).Rows(4).Cells(6).Range.Text) - 2)    ' total service value
        Cells(lngStartingRow, 13).Value = Left(oDoc.Tables(2).Rows(2).Cells(2).Range.Text, Len(oDoc.Tables(2).Rows(2).Cells(2).Range.Text) - 2)    ' service start date=service period
        Cells(lngStartingRow, 2).Value = Left(oDoc.Tables(1).Rows(8).Cells(5).Range.Text, Len(oDoc.Tables(1).Rows(8).Cells(5).Range.Text) - 2)     ' reference=appliance number

        oDoc.Close SaveChanges:=False
        oWord.Quit
        Set oWord = Nothing
        strFileName = Dir$()
    Loop

    'Loop through child folders
    For i = 0 To iFolderCount - 1
        ProcessFiles strFolders(i), "*.doc*"
    Next i
    
End Sub

Open in new window

0
FaustulusCommented:
Hello rugoingwme,
Sorry, it took so long. It was more difficult than expected. Please run the procedure 'ExtractCustomerData' in the attached workbook after setting the Const FullPath to point at your 'Customer' folder. The program will loop through all word documents there and open them. All types of Word documents will be handled, but if the file doesn't have the expected structure an error will occur or, perhaps, the wrong data may be picked, if the table structure differs. I suggest that you find out what kind of errors occur and, within limits, the program can then be taught to handle them.

For each transfer of data the following information is required by the program,
1. In which of your two tables in the word document is the information stored?
2. In which row of that table?
3. In which column of that table?
I combine this into a sequence like 1-2-3 which the program translates to mean Table(1).Row(2).Column(3). Having found the data the program will want to know where to paste them. I added a column ID to the above string, like A-1-2-3. The program will translate this to mean that the data from Table(1).Row(2).Column(3) should be pasted to column A. All of the Const AllCodes at the top of the code is to be understood like that. The string is comma-separated. You can add or remove items and modify and of the instructions. So long as everything you instruct exists the code can execute what you want.
The Const TargetSheet allows you to use another name for the tab to which the data are written. Please modify as required.

Contrary to my original intention there is no provision to check whether an item was already entered or not. Your requirements are likely to be quite complicated. Therefore I suggest that you launch a separate question for that after this code has gone through the trouble-shooting which must now ensue.
131022-Extract-Customer-Data.xlsm
0
FaustulusCommented:
Hello rugoingwme,
If I may, I would suggest to you to review the structure of your invoice files at this time. The first issue is that you have nested your tables within a table. That is manifestly bad practise which serves no purpose but to make your document bigger, less stable and more complicated to access. The other issue is the paragraph formatting within the table. I have observed some negative indents which, effectively, hide part of the cell contents.
Third and last is the use of hard returns within the table. I strongly discourage that. Use only soft returns within table cells, and don't use leading returns at all.
The way to go about this is to launch a separate question here converting the existing format into a new format using code. You would be able to use such code after the code I posted yesterday confirms that all your customer files do have, in fact, the same structure.
0
RugoingwmeAuthor Commented:
Faustulus and MacroShadow, thanks for your help.  I was beginning to suspect that my problem was in the invoice itself, but not sure what to say about the table in the Word doc itself, as it was created by someone else, and a number of invoices have already been generated using it.

FWIW, MacroShadow, I got two errors on the code you wrote; "invalid inside procedure" on the Sub Demo, and "wrong number of arguments or invalid property assignment" on the Sub ProcessFiles.  Not sure what to do with it at this point.
0
MacroShadowCommented:
Sorry my bad. Here try this it seems to work, as far as the invoice is concerned, those you just have to type manually, although it is possible to automate it is a great trouble and not worth the effort.

Option Explicit

Sub Demo()

    Dim strFolder As String

    strFolder = "E:\SONY\Umbra\Organization\customers\Wes Montgomery"
    If Right(strFolder, 1) <> "\" Then strFolder = strFolder & "\"
    
    Call ProcessFiles(strFolder, "*.doc*")

End Sub

Sub ProcessFiles(strFolder As String, strExtension As String)

    ' Variables for the looping
    Dim strFileName As String
    Dim strFolders() As String
    Dim iFolderCount As Integer
    Dim i As Integer
    
    ' Variables for the actual processing of files
    Dim oWord As Object
    Dim oDoc As Object
    Dim lngStartingRow As Long

    ' Collect child folders and add to array
    strFileName = Dir$(strFolder, vbDirectory)
    On Error Resume Next
    Do Until strFileName = ""
        If (GetAttr(strFolder & strFileName) And vbDirectory) = vbDirectory Then
            If Left$(strFileName, 1) <> "." Then
                ReDim Preserve strFolders(iFolderCount)
                strFolders(iFolderCount) = strFolder & strFileName
                iFolderCount = iFolderCount + 1
            End If
        End If
        strFileName = Dir$()
    Loop

    ' process files in current folder
    strFileName = Dir$(strFolder & "\" & strExtension)
    Do Until strFileName = ""
        Set oWord = CreateObject("Word.Application")
        oWord.Visible = False

        Set oDoc = oWord.Documents.Open(strFolder & strFileName)

        lngStartingRow = ActiveWorkbook.Worksheets(1).Range("D" & Rows.Count).End(xlDown).End(xlUp).Offset(1, 0).Row   'starting row
        '    lngStartingRow = Columns("A:A").SpecialCells(xlCellTypeBlanks)(1, 1).Row

        Cells(lngStartingRow, 4).Value = Left(oDoc.Tables(1).Rows(2).Cells(2).Range.Text, Len(oDoc.Tables(1).Rows(2).Cells(2).Range.Text) - 2)     ' company name
        Cells(lngStartingRow, 5).Value = Left(oDoc.Tables(1).Rows(3).Cells(2).Range.Text, Len(oDoc.Tables(1).Rows(3).Cells(2).Range.Text) - 2)     ' address
        Cells(lngStartingRow, 6).Value = Left(oDoc.Tables(1).Rows(4).Cells(2).Range.Text, Len(oDoc.Tables(1).Rows(4).Cells(2).Range.Text) - 2)     ' phone
        Cells(lngStartingRow, 11).Value = Left(oDoc.Tables(1).Rows(7).Cells(2).Range.Text, Len(oDoc.Tables(1).Rows(7).Cells(2).Range.Text) - 2)    ' email address(es)
        Cells(lngStartingRow, 19).Value = Left(oDoc.Tables(1).Rows(5).Cells(5).Range.Text, Len(oDoc.Tables(1).Rows(5).Cells(5).Range.Text) - 2)    ' Invoice number
        Cells(lngStartingRow, 18).Value = Left(oDoc.Tables(1).Rows(6).Cells(5).Range.Text, Len(oDoc.Tables(1).Rows(6).Cells(5).Range.Text) - 2)    ' invoice date
        Cells(lngStartingRow, 15).Value = Left(oDoc.Tables(2).Rows(4).Cells(6).Range.Text, Len(oDoc.Tables(2).Rows(4).Cells(6).Range.Text) - 2)    ' total service value
        Cells(lngStartingRow, 13).Value = Left(oDoc.Tables(2).Rows(2).Cells(2).Range.Text, Len(oDoc.Tables(2).Rows(2).Cells(2).Range.Text) - 2)    ' service start date=service period
        Cells(lngStartingRow, 2).Value = Left(oDoc.Tables(1).Rows(8).Cells(5).Range.Text, Len(oDoc.Tables(1).Rows(8).Cells(5).Range.Text) - 2)     ' reference=appliance number

        oDoc.Close SaveChanges:=False
        oWord.Quit
        Set oWord = Nothing
        strFileName = Dir$()
    Loop

    ' Loop through child folders
    For i = 0 To iFolderCount - 1
        ProcessFiles strFolders(i), strExtension
    Next i
    
End Sub

Open in new window

0
FaustulusCommented:
Hello rugoingwme,
Have you tried the code I gave you? It shouldn't have any problem. It's advantage is that you can easily specify which data you want to pick from the invoces and where to paste them - all without touching the actual code.
The reason I suggested to review the Word template "at this time" was becasue code already exists within my submitted solution to open every one of the existing files. Therefore it would be a relatively minor matter to correct any unpleasantries that might exist there. If left till later it will become more and more difficult.
0
RugoingwmeAuthor Commented:
Hi Faustulus,

first, I'm sorry that it's taken so long to get back to you on this.  I did try your code, and as i executed, it just seemed to run.  I wasnt sure what to actually change so that the code would run against my real word docs, or my real excel spreadsheet.  I tried changing the directory once I got into the macro itself, but it seemed that still didn't work against my files.  It might help if the downloaded file has a button or something that I could use to start the program running on my command.  Or maybe it already does, and I missed it?

Hi MacroShadow,

Same to you as well; I'm sorry that its taken too long to respond to you as well.  I tried your new code, and I cut and pasted into your code the actual file location.  The code seemed to compile and run, but it didn't do anything to the excel spreadsheet.  I didn't have the word document open when I ran the macro; does the document need to be open that i'm going to use?

FWIW, I'm in China at the moment, so i'm likely off from your responses by a few hours if that makes a difference to you guys.  Thanks again for your help, I do appreciate it.
0
MacroShadowCommented:
1. There is no need to open the Word document the code does it.
2. The code I posted will only work if (A) the tables are not nested (B) the tables don't contain any merged or split cells.
3. You will have to change lines 52-60 to extract the data you need. Read the comments closely and compare the the document you uploaded to see how it must be done.
4. I tested the code and it works.
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
FaustulusCommented:
Thank you for your comment.
At this time I'm travelling and way behind on everything. I will try to catch up somewhat on Sunday but that won't make much of a dent on what is needed. I work from the top of the pile down. If you have the time and patience to wait I can assure you that I will get around to your problem.
Of course, at the time of posting my reply I thought that it solved your problem. Running the code on a sheet that already shows the solution won't be much fun. Perhaps you can substitute a sheet that still needs sorting out. But that is said without looking at anything.
Regards, from where the weather is balmy and the nights start late - whether you want to sleep or not.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.