PDA

View Full Version : [SOLVED] Timing of UserForm Display



brent.fraser
12-04-2013, 11:09 AM
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
12-04-2013, 01:13 PM
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
12-05-2013, 12:39 AM
Instead of removing that line, just add Application.ScreenUpdating = True immediately before showing the form.