Consulting

Results 1 to 5 of 5

Thread: Copy text from word to excel - "Out of disk space" error

  1. #1
    VBAX Regular
    Joined
    Apr 2007
    Posts
    41
    Location

    Copy text from word to excel - "Out of disk space" error

    Hi evereryone,

    With the follwing procedure which intends to retrieve specific text (red square in the above image) from word documents:
    Proposta.jpg


    Sub Abrir()
    
    
    Dim FolderName As String
    Dim FileName As String
    Dim NewDoc As Object
    Dim NewWordFile As Object
    
    
    Dim A As String
    Dim r As Integer
    
    
    
    
    Range("A2:B1000").Value = ""
    Range("A2").Select
    
    
    r = 2
    
    
    FolderName = "C:\Users\njesus\Documents\Os meus documentos\"
    FileName = Dir(FolderName & "*.doc*")
    
    
    
    
    Do While FileName <> ""
    
    
    On Error Resume Next
        Set NewDoc = CreateObject("word.application")
        NewDoc.Application.Visible = False
        Set NewDoc = GetObject(FolderName & FileName)
    
    
        A = NewDoc.Range(12, 25)
        Range("A" & r).Value = A
      
        A = NewDoc.Range(200, 500)
        Range("B" & r).Value = A
       
    r = r + 1
       
        NewDoc.Close SaveChanges:=wdDoNotSaveChanges
        NewWordFile.Quit
              
    FileName = Dir()
    
    
    Set NewDoc = Nothing
    Set NewWordFile = Nothing
    
    
    Loop
    
    
    End Sub
    works for folders with a few word documents, but for folders with more than 100 documents it is creating huge amount of data and I keep run out of disk space. Can anyone help me understanding why is this happening?

    Thank you!

    Regards
    Microsoft 2010 | VBA 7.1

  2. #2
    VBAX Expert
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    814
    Location
    You could try it like the below, there were too many bits inside the loop:
    Sub Abrir()
        Dim FolderName As String
        Dim FileName As String
        Dim wdApp As Object
        Dim NewDoc As Object
    
        Range("A2:B" & Rows.Count).ClearContents
    
        FolderName = "C:\Users\njesus\Documents\Os meus documentos\"
        FileName = Dir(FolderName & "*.doc*")
        Set wdApp = CreateObject("word.application")
        wdApp.Application.Visible = False
        
        Do While FileName <> ""
            Set NewDoc = GetObject(FolderName & FileName)
            Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1).Resize(, 2).Value = Array(NewDoc.Range(12, 25), NewDoc.Range(200, 500))
            NewDoc.Close SaveChanges:=False
            FileName = Dir()
        Loop
        
        wdApp.Quit
    End Sub
    Last edited by georgiboy; 07-07-2022 at 08:41 AM.
    If things don't change they stay the same
    Quite often there is a picnic problem (problem in chair not in computer)
    "We were not told it was impossible, so we did it."

  3. #3
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,586
    Keep it simple.
    Avoid 'On error Resume Next'

    Sub M_snb()
      c00="C:\Users\njesus\Documents\Os meus documentos\"
      c01= Dir(c00 & "*.doc*")
    
      do while c01<>""
        with getobject(c00 & c01)
          c02=c02 & vblf & .paragraphs(7).range.text
          .close 0
        end with
        c01=Dir
      loop
    
      Msgbox c02
    End Sub

  4. #4
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,398
    Location
    Undoubtedly, creating multiple Word instances that you don't kill has choked your system(Hint: NewWordFile.Quit does not relate to Set NewDoc = CreateObject("word.application")). Your code has other issues, too.

    Here's a more flexible approach that allows for the possibility that doesn't require knowing in advance which paragraphs contain your strings or, especially for the second string, how long it might be:
    Sub Abrir()
    Dim StrFldr As String, StrFlNm As Strin, WdObj As Object, WdDoc As Object, xlSht As Worksheet, r As Long
    StrFldr = "C:\Users\njesus\Documents\Os meus documentos\": r = 1
    Set WdObj = CreateObject("Word.Application"): WdObj.Visible = False
    Set xlSht = ActiveSheet: xlSht.Range("A2:B" & Rows.Count).ClearContents
    StrFlNm = Dir(StrFldr & "*.doc*")
    Do While StrFlNm <> ""
      r = r + 1
      Set WdDoc = WdObj.Documents.Open(StrFldr & StrFlNm)
      With WdDoc
        With .Range
          With .Find
            .MatchWildcards = True
            .Text = "N/O Ref[!\:]@:[!/]@/[! ]@>"
            .Execute
          End With
          If .Find.Found Then xlSht.Range("A" & r).Value = Split(.Text, ":")(1)
        End With
        With .Range
          With .Find
            .MatchWildcards = True
            .Text = "ASSUNTO:[!^13]@^13"
            .Execute
          End With
          If .Find.Found Then xlSht.Range("B" & r).Value = Split(.Text, "ASSUNTO:")(1)
        End With
        .Close False
      End With
      StrFlNm = Dir()
    Loop
    Set WdDoc = Nothing: Set WdObj = Nothing: Set xlSht = Nothing
    End Sub
    Last edited by macropod; 07-07-2022 at 08:24 PM.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  5. #5
    VBAX Regular
    Joined
    Apr 2007
    Posts
    41
    Location
    Hi,

    Thank you all for your reply!

    Quote Originally Posted by macropod View Post
    Undoubtedly, creating multiple Word instances that you don't kill has choked your system(Hint: NewWordFile.Quit does not relate to Set NewDoc = CreateObject("word.application")). Your code has other issues, too.
    True! In the meanwhile i remember to opened the windows task bar and saw a bunch of word documents tasks opened, it was that what was filling my disk, so I changed the "CreateObject("word.application")" to "GetObject("word.application")" and it worked, but since the code is not optimized it takes around 1h to do 150 documents....

    macropod it was that code that I was looking for, it works like a charm! thank you very much!!!

    Microsoft 2010 | VBA 7.1

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •