Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 01-28-2021, 11:44 PM
TA9523 TA9523 is offline Copy words from word to excel Windows 10 Copy words from word to excel Office 2016
Novice
Copy words from word to excel
 
Join Date: Jan 2021
Posts: 8
TA9523 is on a distinguished road
Default Copy words from word to excel

Hi,


I have 300 docx files(file name ZXXX1 and etc.), which contains a lot information. I need to find in each document words which start with "1d-", "2d-", "1e-","1 d-", "2 d-",(letters can also be uppercase "1D-" etc.) and copy this words to excel with doc file name.
At the end, I should get the following Excel file with two columns:

|Doc file name| TAG|
|-------------|-------|
|zxxxx1|1d-xxx1|
|zxxxx1|2e-xxx1|
|zxxxx2|2D-xxxxxx1|
|zxxxx3|no matches|

-("no matches" if the file does not contain words starting with
these characters)
Thanks in advance to everyone who can somehow help me.
Reply With Quote
  #2  
Old 01-29-2021, 01:03 AM
gmayor's Avatar
gmayor gmayor is offline Copy words from word to excel Windows 10 Copy words from word to excel Office 2016
Expert
 
Join Date: Aug 2014
Posts: 4,101
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

The following should work. Create a workbook with Sheet1 having two columns and a header row. Change the path and workbook name as appropriate.
Code:
Option Explicit
'Graham Mayor - https://www.gmayor.com - Last updated - 29 Jan 2021 
Const strWB As String = "C:\Path\IDLog.xlsx"    'must exist - change as appropriate
Const strSheet As String = "Sheet1"    'Two column worksheet with header row
Sub Batch_GetID()
Dim vID As Variant
Dim strValues As String
Dim strFile As String
Dim strPath As String
Dim oDoc As Document
Dim oRng As Range
Dim i As Integer
Dim bFound As Boolean
Dim fDialog As FileDialog

    vID = Array("1d-", "2d-", "1e-", "1 d-", "2 d-", "1D-", "2D-", "1E-", "1 D-", "2 D-")

    Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    With fDialog
        .Title = "Select folder and click OK"
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewList
        If .Show <> -1 Then
            MsgBox "Cancelled By User", , "List Folder Contents"
            Exit Sub
        End If
        strPath = fDialog.SelectedItems.Item(1)
        Do Until Right(strPath, 1) = "\"
            strPath = strPath & "\"
        Loop
    End With
    strFile = Dir$(strPath & "z*.docx")
    While strFile <> ""
        Set oDoc = Documents.Open(strPath & strFile)
        bFound = False
        For i = 0 To UBound(vID)
            Set oRng = oDoc.Range
            With oRng.Find
                Do While .Execute(findText:=CStr(vID(i)) & "[0-9]{1,}", MatchWildcards:=True)
                    strValues = strFile & "', '" & oRng.Text
                    WriteToWorksheet strWB, strSheet, strValues
                    bFound = True
                    oRng.Collapse 0
                Loop
            End With
        Next i
        If bFound = False Then
            strValues = strFile & "', '" & "no matches"
            WriteToWorksheet strWB, strSheet, strValues
        End If
        oDoc.Close SaveChanges:=wdDoNotSaveChanges
        strFile = Dir$()
        DoEvents
    Wend
    MsgBox "Process complete"
lbl_Exit:
    Set fDialog = Nothing
    Set oDoc = Nothing
    Set oRng = Nothing
    Exit Sub
End Sub


Private Function WriteToWorksheet(strWorkbook As String, _
                                  strRange As String, _
                                  strValues As String)
Dim ConnectionString As String
Dim strSQL As String
Dim CN As Object
    ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                       "Data Source=" & strWorkbook & ";" & _
                       "Extended Properties=""Excel 12.0 Xml;HDR=YES;"";"
    strSQL = "INSERT INTO [" & strRange & "$] VALUES('" & strValues & "')"
    Set CN = CreateObject("ADODB.Connection")
    Call CN.Open(ConnectionString)
    Call CN.Execute(strSQL, , 1 Or 128)
    CN.Close
    Set CN = Nothing
lbl_Exit:
    Exit Function
End Function
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote
  #3  
Old 01-29-2021, 01:04 AM
macropod's Avatar
macropod macropod is offline Copy words from word to excel Windows 10 Copy words from word to excel Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Cross-posted at: vba - Copy words from word to excel - Stack Overflow
For cross-posting etiquette, please read: Excelguru Help Site - A message to forum cross posters
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #4  
Old 01-29-2021, 04:01 AM
TA9523 TA9523 is offline Copy words from word to excel Windows 10 Copy words from word to excel Office 2016
Novice
Copy words from word to excel
 
Join Date: Jan 2021
Posts: 8
TA9523 is on a distinguished road
Default

Quote:
Originally Posted by macropod View Post
Sorry for cross-reporting. In "stackoverflow" my question is showing closed, so i thought no one could see it.
Reply With Quote
  #5  
Old 01-29-2021, 05:18 AM
TA9523 TA9523 is offline Copy words from word to excel Windows 10 Copy words from word to excel Office 2016
Novice
Copy words from word to excel
 
Join Date: Jan 2021
Posts: 8
TA9523 is on a distinguished road
Default

Gramor, thanks for help, but I have following error:
I had error in line
Code:
Set oRng = oDoc.Range With oRng.Find
- I changed oRng.Find to oRng = oDoc.Find and it start works. But next error happened when i chose folder in dialog window.
"Run-time error "429" ActivateX component can't create object" and line
Code:
Set oDoc = Documents.Open(strPath & strFile)
- highlited. How can I fix it?
Thanks in advance
Reply With Quote
  #6  
Old 01-29-2021, 05:24 AM
gmayor's Avatar
gmayor gmayor is offline Copy words from word to excel Windows 10 Copy words from word to excel Office 2016
Expert
 
Join Date: Aug 2014
Posts: 4,101
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

Code:
Set oRng = oDoc.Range With oRng.Find
should be
Code:
Set oRng = oDoc.Range 
With oRng.Find
as shown in the listing.
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote
  #7  
Old 01-29-2021, 05:33 AM
TA9523 TA9523 is offline Copy words from word to excel Windows 10 Copy words from word to excel Office 2016
Novice
Copy words from word to excel
 
Join Date: Jan 2021
Posts: 8
TA9523 is on a distinguished road
Default

Quote:
Originally Posted by gmayor View Post
Code:
Set oRng = oDoc.Range With oRng.Find
should be
Code:
Set oRng = oDoc.Range 
With oRng.Find
as shown in the listing.
In this case following error occur:
"compile error" - Argument not optional
Reply With Quote
  #8  
Old 01-29-2021, 09:33 PM
gmayor's Avatar
gmayor gmayor is offline Copy words from word to excel Windows 10 Copy words from word to excel Office 2016
Expert
 
Join Date: Aug 2014
Posts: 4,101
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

Put the code in a new module.
Ensure that it appears as written, with no more missing line breaks as previously noted.
It should copy from the forum without error.
Click Debug > Compile Normal.
Which line reports the error?
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote
  #9  
Old 01-30-2021, 12:22 AM
TA9523 TA9523 is offline Copy words from word to excel Windows 10 Copy words from word to excel Office 2016
Novice
Copy words from word to excel
 
Join Date: Jan 2021
Posts: 8
TA9523 is on a distinguished road
Default

I did everything how you wrote, the same error" Argument not optional" occurred on line
Quote:
With oRng.Find
. Just for information after that google it and find solution to change line
Quote:
Dim oRng As Range
to this line
Quote:
Dim oRng As Word.Range
And everything work correctly, but it shows for all documents "no matches", although I checked in these documents there are suitable words. Just for note except adding "Word.Range" to line "Dim ORng" I did not do any changes in code and copy everything correctly.(Sorry for bad English and thanks in advance)
Reply With Quote
  #10  
Old 01-30-2021, 01:48 AM
TA9523 TA9523 is offline Copy words from word to excel Windows 10 Copy words from word to excel Office 2016
Novice
Copy words from word to excel
 
Join Date: Jan 2021
Posts: 8
TA9523 is on a distinguished road
Default

UPDATED.
I can fix this problem using this code
Quote:
Do While .Execute(findText:=CStr(vID(i)) & "<*>", MatchWildcards:=True)
And this code works excellent, except one thing. I have cases where tag "1D-EXX94503-A3-B25"
In this case code return only "1D-EXX94503" till the first "-" characters. How can I fix it? I think I need to return value until first space but I don't know how to realize this or maybe somebody can suggest another way
Reply With Quote
  #11  
Old 01-30-2021, 05:26 AM
gmayor's Avatar
gmayor gmayor is offline Copy words from word to excel Windows 10 Copy words from word to excel Office 2016
Expert
 
Join Date: Aug 2014
Posts: 4,101
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

The code I posted was intended to be run from Word. The error message suggest that you are running it from Excel.
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote
  #12  
Old 01-30-2021, 05:42 AM
TA9523 TA9523 is offline Copy words from word to excel Windows 10 Copy words from word to excel Office 2016
Novice
Copy words from word to excel
 
Join Date: Jan 2021
Posts: 8
TA9523 is on a distinguished road
Default

I tried to running it from Word, in this case error "Argument not optional" didn't occur, but whatever excel shows "no matches" for all documents. I think problem with following part of code:
Quote:
Do While .Execute(findText:=CStr(vID(i)) & "[0-9]{1,}", MatchWildcards:=True)
How I said before, when I changed this part of code to this:
Quote:
Do While .Execute(findText:=CStr(vID(i)) & "<*>", MatchWildcards:=True)
everything works excellent, except the cases where TAGs have two or more "-" . In this case information is copied up to the second "-". Could you suggest how can I fix it?
Reply With Quote
  #13  
Old 01-30-2021, 06:40 AM
gmayor's Avatar
gmayor gmayor is offline Copy words from word to excel Windows 10 Copy words from word to excel Office 2016
Expert
 
Join Date: Aug 2014
Posts: 4,101
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

The code I posted assumed that the 'x' indicated a number. Try instead
Code:
Do While .Execute(findText:=CStr(vID(i)) & "[0-9A-Z\-]{1,}>", MatchWildcards:=True)
See Replace using wildcards
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote
  #14  
Old 01-30-2021, 06:50 AM
TA9523 TA9523 is offline Copy words from word to excel Windows 10 Copy words from word to excel Office 2016
Novice
Copy words from word to excel
 
Join Date: Jan 2021
Posts: 8
TA9523 is on a distinguished road
Thumbs up

Quote:
Originally Posted by gmayor View Post
The code I posted assumed that the 'x' indicated a number. Try instead
Code:
Do While .Execute(findText:=CStr(vID(i)) & "[0-9A-Z\-]{1,}>", MatchWildcards:=True)
See Replace using wildcards
Thanks a lot. It works excellent!
Reply With Quote
Reply

Tags
ms excel 2016, ms word, vba

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Copy words from word to excel Copy & Paste Word Doc from Excel VBA RMerckling Excel Programming 4 04-18-2018 03:57 PM
Copy words from word to excel copy a specific words to excel list romanticbiro Word VBA 12 12-03-2014 05:12 AM
Copy data from Word into Excel chinchee Word VBA 18 05-23-2014 05:25 AM
Copy and paste words on right side of page Videolife Word 3 01-26-2013 12:54 PM
how to copy all ms word tables into excel rehan129 Word 0 01-28-2012 10:17 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 07:52 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft