Timing of UserForm Display

[brent.fraser]

Hello all,

I have an excel macro that pulls information from word document content controls and places the information into the spreadsheet and it is woking well. I have is that I display a "userform" stating that the import is complete. The user has an option of importing one file or multiple.

The issue is that in the multiple import, the "userform" is displayed after the information is in the spreadsheet. With the import of a single file, the "userform" is displayed and when it goes away (I have it on a timer), then the information gets put into the spreadsheet. So in essence, it is saying that it is done before the information is actually there. I am not sure why the timing is off though.

The one that the timing is off (single file) is below:

Sub ExtractWordInfoSingle()
    Dim fd As FileDialog
    Dim wdApp As New Word.Application
    Dim wdDoc As Word.Document
    Dim CCtrl As Word.ContentControl
    Dim WkSht As Worksheet, i As Long, j As Long
    Set WkSht = ActiveSheet
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    fd.AllowMultiSelect = False
    fd.Title = "Select the Vendor Questionnaire to use"
    fd.Filters.Add "Documents", "*.doc; *.docm; *.docx", 1
    If fd.Show Then
    strWordDocument = fd.SelectedItems(1)
    strPath = strWordDocument
    strFile = Right(strPath, Len(strPath) - InStrRev(strPath, "\"))
    End If
        iReturnValue = MsgBox("Is this the correct file?" & vbLf + strFile, vbYesNo + vbQuestion, "Is this the Correct File?")
 Do While iReturnValue = vbNo
 MsgBox "Select the correct file to use."
  fd.Show
    strWordDocument = fd.SelectedItems(1)
    strPath = strWordDocument
    strFile = Right(strPath, Len(strPath) - InStrRev(strPath, "\"))
  iReturnValue = MsgBox("Is this the correct folder?" & vbLf + strFile, vbYesNo + vbQuestion, "Is this the Correct Folder?")
Loop
Application.ScreenUpdating = False
Set WkSht = ActiveSheet
i = WkSht.Cells(WkSht.Rows.Count, 1).End(xlUp).Row
If strFile <> "" Then
  i = i + 1
  Set wdDoc = wdApp.Documents.Open(Filename:=strWordDocument, AddToRecentFiles:=False, Visible:=False)
  With wdDoc
    j = 0
    For Each CCtrl In .ContentControls
      j = j + 1
      WkSht.Cells(i, j) = CCtrl.Range.Text
    Next
  End With
End If
    Call ReplaceYes
    Call ReplaceNo
    Call ReplaceBlankFields
    Call ChangeDateFormat
    wdDoc.Close SaveChanges:=False
    wdApp.Quit
Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing
Call ShowForm
End Sub

Private Sub ShowForm()
    With UserForm1
        .Label1 = "You have successfully imported one form."
        .Label1.TextAlign = fmTextAlignCenter
        .Show
    End With
    Unload UserForm1
End Sub

The one that works (multiple files) is below:

Sub ExtractWordInfoMultiple()
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    Dim strFolder As String
    Dim wdApp As New Word.Application
    Dim wdDoc As Word.Document
    Dim CCtrl As Word.ContentControl
    Dim WkSht As Worksheet, i As Long, j As Long
    Set WkSht = ActiveSheet
    i = WkSht.Cells(WkSht.Rows.Count, 1).End(xlUp).Row
    With fd
        fd.Title = "Select the folder that contains the files that you want to extract data from."
        If fd.Show = -1 Then
            strFolder = .SelectedItems(1) & "\"
        Else
            MsgBox "You did not select a folder."
            Exit Sub
        End If
        iReturnValue = MsgBox("Is this the correct folder?" & vbLf + strFolder, vbYesNo + vbQuestion, "Is this the Correct Folder?")
Do While iReturnValue = vbNo
 MsgBox "Select the correct folder to use."
  fd.Show
  iReturnValue = MsgBox("Is this the correct folder?" & vbLf + strFolder, vbYesNo + vbQuestion, "Is this the Correct Folder?")
Loop
  End With
        strFile = Dir$(strFolder & "*.doc*")
Do While Len(strFile) > 0
    Count = Count + 1
  i = i + 1
  Set wdDoc = Documents.Open(strFolder & strFile, AddToRecentFiles:=False, Visible:=False)
  With wdDoc
    j = 0
    For Each CCtrl In .ContentControls
      j = j + 1
      WkSht.Cells(i, j) = CCtrl.Range.Text
    Next
    End With
    strFile = Dir
Loop
    Call ReplaceYes
    Call ReplaceNo
    Call ReplaceBlankFields
    Call ChangeDateFormat
    wdDoc.Close SaveChanges:=False
    wdApp.Quit
Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing
Call ShowForm2
    End Sub

Private Sub ShowForm2()
    With UserForm2
        .Label1 = "You have successfully imported " & Count & " forms."
        .Label1.TextAlign = fmTextAlignCenter
        .Show
    End With
    Unload UserForm2
End Sub

Not a huge deal, it is just interesting that the timing would be off here.

Any skilled eyes that can help is appreciated.

Thx peoples.

[brent.fraser]

I think I solved it. The culprit seems to be:

Application.ScreenUpdating = False 

I removed that line and it works like a charm.

[Jan Karel Pieterse]

Instead of removing that line, just add Application.ScreenUpdating = True immediately before showing the form.