If you do this properly you DO NOT need a userform in Excel. Your Word userform can write directly to the appropriate row in Excel. For example, the following code adds your data to columns A-D of a new row in the specified Excel worksheet without needing that workbook to be open beforehand:
Private Sub CommandButton1_Click()
Dim StrTxt As String, A As Long, L As Long, p As Long, StrWkBk As String
Dim xlApp As Object, xlWkBk As Object, xlWkSht As Object, dRow As Long
Dim bStrt As Boolean, bOpen As Boolean, bSht As Boolean
StrWkBk = "C:\Users\" & Environ("Username") & "\Documents\Workbook Name.xls"
Const StrWkSht As String = "Sheet1"
' Get the document data
With ActiveDocument
StrTxt = .Bookmarks("statement_of").Range.Text
A = (Len(.Range.Text) - Len(Replace(.Range.Text, "INAUDIBLE-A", ""))) / Len("INAUDIBLE-A")
L = (Len(.Range.Text) - Len(Replace(.Range.Text, "INAUDIBLE-L", ""))) / Len("INAUDIBLE-L")
p = .ComputeStatistics(wdStatisticPages)
End With
' Does the Excel file exist?
If Dir(StrWkBk) = "" Then
MsgBox "Cannot find the designated workbook: " & StrWkBk, vbExclamation
Exit Sub
End If
' Does another user have the file open?
If IsFileLocked(StrWkBk) = True Then
' Report and exit if true
MsgBox "The Excel workbook is in use by:" & vbCr & GetFileOwner(StrWkBk) & _
vbCr & vbCr & "Please try again later.", vbExclamation, "File in use"
Exit Sub
End If
bStrt = False ' Flag to record if we start Excel, so we can close it later.
bOpen = False ' Flag to record if we open the workbook, so we can close it later.
bSht = False ' Flag to record if our worksheet exists.
' Is Excel is already running?
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
' Start Excel if it isn't running
If xlApp Is Nothing Then
Set xlApp = CreateObject("Excel.Application")
If xlApp Is Nothing Then
MsgBox "Can't start Excel.", vbExclamation
Exit Sub
End If
' Record that we've started Excel.
bStrt = True
End If
On Error GoTo 0
With xlApp
' Hide our Excel session if we started it
If bStrt = True Then .Visible = False
' Check if the workbook is open.
For Each xlWkBk In .Workbooks
If xlWkBk.FullName = StrWkBk Then ' The current user has it open
Set xlWkBk = xlWkBk
bOpen = True
Exit For
End If
Next
' If not open by the current user.
If bOpen = False Then
' The file is available, so open it.
Set xlWkBk = .Workbooks.Open(FileName:=StrWkBk)
If xlWkBk Is Nothing Then
MsgBox "Cannot open:" & vbCr & StrWkBk, vbExclamation
GoTo ErrExit
End If
End If
' Does our worksheet exist?
With xlWkBk
For i = 1 To .Sheets.Count
If .Sheets(i).Name = StrWkSht Then bSht = True
Exit For
Next
End With
If bSht = False Then
MsgBox "Cannot find the worksheet named: '" & StrWkSht & "' in:" & vbCr & StrWkBk, vbExclamation
GoTo ErrExit
End If
End With
' Everything is OK, so update our worksheet
Set xlWkSht = xlWkBk.Sheets(StrWkSht)
With xlWkSht
dRow = .UsedRange.Cells.SpecialCells(xlCellTypeLastCell).Row + 1
.Range("A" & dRow).Value = StrTxt
.Range("B" & dRow).Value = A
.Range("C" & dRow).Value = L
.Range("D" & dRow).Value = p
End With
ErrExit:
If Not xlWkBk Is Nothing Then If bOpen = False Then xlWkBk.Close Savechanges:=True
If Not xlApp Is Nothing Then If bStrt = True Then xlApp.Quit
Set xlWkSht = Nothing: Set xlWkBk = Nothing: Set xlApp = Nothing
Application.ScreenUpdating = True
End Sub
Function IsFileLocked(strFileName As String) As Boolean
On Error Resume Next
Open strFileName For Binary Access Read Write Lock Read Write As #1
Close #1
IsFileLocked = Err.Number
Err.Clear
End Function
Function GetFileOwner(strFileName)
'Based on: http://www.vbsedit.com/scripts/security/ownership/scr_1386.asp
Dim objWMIService As Object, objFileSecuritySettings As Object, objSD As Object
Set objWMIService = GetObject("winmgmts:")
Set objFileSecuritySettings = _
objWMIService.Get("Win32_LogicalFileSecuritySetting='" & strFileName & "'")
If objFileSecuritySettings.GetSecurityDescriptor(objSD) = 0 Then
GetFileOwner = objSD.Owner.Name
Else
GetFileOwner = "Unknown"
End If
End Function
Most of the code is used to check whether Excel is running, whether the workbook & worksheet exists, and whether you or someone else has it open - most of which your existing code should have, anyway. You would, of course, need to edit StrWkBk & StrWkSht to suit your requirements.
Reply With Quote
