Link to home
Start Free TrialLog in
Avatar of Rugoingwme
Rugoingwme

asked on

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
Avatar of Joe Howard
Joe Howard
Flag of United States of America image

Please supply the word doc, it is impossible to do what you ask without knowing the structure of the document.
Avatar of Rugoingwme
Rugoingwme

ASKER

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
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?
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!
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?
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.
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

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
SOLUTION
Avatar of Faustulus
Faustulus
Flag of Singapore image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
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.
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

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.
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.
ASKER CERTIFIED SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
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.