Word to excel

[suji]

Hi,

This is a code I intend to use to transfer data from word to an excel file. Can u guys please have a look at it and see if there is a better way to code this.

The code is working fine when the excel file is closed but gives error when the excel file is open with unsaved changes. Iam using office 2003.

Thanks
Suji



Sub WorkOnAWorkbook()

Dim oXL As Excel.Application
Dim oWB As Excel.Workbook
Dim oSheet As Excel.Worksheet
Dim oRng As Excel.Range
Dim ExcelWasNotRunning As Boolean
Dim WorkbookToWorkOn As String

'specify the workbook to work on
WorkbookToWorkOn = "G:\Word2Excel2.xls"

'If Excel is running, get a handle on it; otherwise start a new instance of Excel
On Error Resume Next
Set oXL = GetObject(, "Excel.Application")


If Err Then
ExcelWasNotRunning = True
Set oXL = New Excel.Application
End If

On Error GoTo Err_Handler


'Open the workbook
Set oWB = oXL.Workbooks.Open(fileName:=WorkbookToWorkOn)


rownum = 1
testString = oWB.Worksheets(1).Cells(rownum, 1).Value


Do Until testString = "ABC"
rownum = rownum + 1
testString = oWB.Worksheets(1).Cells(rownum, 1).Value
If testString < 1 Then Exit Do
Loop


With oWB.Worksheets(1)
.Cells(rownum, 1).Formula = "AAA"
.Cells(rownum, 2).Formula = "BBB"
.Cells(rownum, 3).Formula = "CCC"
.Cells(rownum, 4).Formula = "DDD"
.Cells(rownum, 5).Formula = "EEE"
End With


oWB.Save


If ExcelWasNotRunning Then
oXL.Quit
End If

'release object references.
Set oRng = Nothing
Set oSheet = Nothing
Set oWB = Nothing
Set oXL = Nothing

'quit
Exit Sub

Err_Handler:
MsgBox WorkbookToWorkOn & " caused a problem. " & Err.Description, vbCritical, _
"Error: " & Err.Number
If ExcelWasNotRunning Then
oXL.Quit
End If


End Sub

[lucas]

You will probably need to check to see if the file is open and then decide what you want to do if it is already open.. Bob's KB entry to check to see if a file is open...

http://www.vbaexpress.com/kb/getarticle.php?kb_id=468

[suji]

Is that much different from what I error handling that I already have in my code .. Pls advice.
Thanks

[lucas]

Well I think it is. You can detect the error but can you be sure that it is an error caused by trying to open a file that is already open?

If you use an if statement to check to see if the file is open and it is not then you can fall back on what you have, if you find that it is open you would just activate it...then run the rest of your code.

if it is not open then use Workbooks.Open Else.....Activate.

[suji]

Can u please help me to incorporate this into my code.. I am not very good at this.
Thanks
Suji

[lucas]

Untested but you should be able to do it something like:
Option Explicit
Sub WorkOnAWorkbook()

Dim oXL As Excel.Application
Dim oWB As Excel.Workbook
Dim oSheet As Excel.Worksheet
Dim oRng As Excel.Range
Dim ExcelWasNotRunning As Boolean
Dim WorkbookToWorkOn As String
Dim rownum As Long
Dim testString As String

'specify the workbook to work on
WorkbookToWorkOn = "G:\Word2Excel2.xls"

Set oXL = GetObject(, "Excel.Application")


'Open the workbook
If Not IsFileOpen("G:\Word2Excel2.xls") Then

Set oWB = oXL.Workbooks.Open(FileName:=WorkbookToWorkOn)

Else: Set oWB = oXL.ActiveWorkbook = WorkbookToWorkOn

End If
rownum = 1
testString = oWB.Worksheets(1).Cells(rownum, 1).Value


Do Until testString = "ABC"
rownum = rownum + 1
testString = oWB.Worksheets(1).Cells(rownum, 1).Value
If testString < 1 Then Exit Do
Loop


With oWB.Worksheets(1)
.Cells(rownum, 1).Formula = "AAA"
.Cells(rownum, 2).Formula = "BBB"
.Cells(rownum, 3).Formula = "CCC"
.Cells(rownum, 4).Formula = "DDD"
.Cells(rownum, 5).Formula = "EEE"
End With


oWB.Save


If ExcelWasNotRunning Then
oXL.Quit
End If

'release object references.
Set oRng = Nothing
Set oSheet = Nothing
Set oWB = Nothing
Set oXL = Nothing

'quit
Exit Sub

'Err_Handler:
' MsgBox WorkbookToWorkOn & " caused a problem. " & Err.Description, vbCritical, _
' "Error: " & Err.Number
' If ExcelWasNotRunning Then
' oXL.Quit
' End If


End Sub

Edit: I changed a file path that was incorrect.

[suji]

I am getting runtime error 429 . Active X component cant create object.

[lucas]

did you set a reference to the MSExcel object library?

in the vbe tools-references.

[suji]

Yes I have set reference to microsoft excel 11.0 object library
Thanks
Suji

[RECrerar]

I hope noone minds is I reactivate this thread, it seems to be along the lines of the issue I'm experiencing.

I'm trying to connect to an Excel file from word so that I can then import data. The following code does nothing but try and establish the connection. It works fine as long as the file is oirginally closed but it bugs on the line that tries to connect to an open file.

Also, this is a really dense question, but how do I make it make Excel visible. I tried wb.visible = true but that is not correct.

I have reasonable experience of using VBA in Excel but absolutely none in Word, so I hope the questions are not too dim.

Sub GetExcelData()
Dim Xl As Excel.Application, Wb As Excel.Workbook, i As Integer
Dim XlOpen As Boolean
' Open Excel
On Error Resume Next
Set Xl = GetObject(, "Excel.Application") 'Select Xl app if open
If Err.Number <> 0 Then 'If Excels not already open then open an instance
Set Xl = CreateObject("Excel.Application")
' Xl.Visible = True 'If you want Excel to be visible. Its invisible by default.
Else
XlOpen = True 'an indicator so we know whether to close Xl app or not when finished
End If
On Error GoTo 0
Dim objDialog, boolResult
Set objDialog = CreateObject("UserAccounts.CommonDialog")
objDialog.Filter = "Excel File|*.xls"
objDialog.FilterIndex = 1
boolResult = objDialog.ShowOpen
If boolResult = 0 Then
Exit Sub
End If
Dim fileName As String
fileName = objDialog.fileName
If Not IsFileOpen(fileName) Then
Set Wb = Xl.Workbooks.Open(fileName)
Else
Set Wb = Xl.ActiveWorkbook = fileName 'THIS LINE ERRORS
End If

CleanUp:
' If XlOpen = False Then Xl.Quit 'close xl if we started it otherwise leave open
Set Xl = Nothing
Set Wb = Nothing

End Sub

I have my references set up.

[RECrerar]

No worries.

I think I have solved my own issue.

I have changed the offending line to:


Xl.Workbooks("sampleData.xls").Activate
Set Wb = Xl.ActiveWorkbook


This is not pperfect yet as what I really need to do is have a variable for the workbook name. I am planning on doing this by trimming objDialog.fileName, unless anyone knows of a better way?

[RECrerar]

Okay, I do realise I'm talking to myself, but this is how I solved the issue. The following code, check if excel is open and if not opens it, allows the user to select the file they want and then either opens or activates that (depending on whether or not it is already open).

It is probably not the neatest code but it works and I don't think it's too bad.

Sub GetExcelData()
Dim Xl As Excel.Application, Wb As Excel.Workbook, i As Integer
Dim XlOpen As Boolean
' Open Excel
On Error Resume Next
Set Xl = GetObject(, "Excel.Application") 'Select Xl app if open
If Err.Number <> 0 Then 'If Excels not already open then open an instance
Set Xl = CreateObject("Excel.Application")
' Xl.Visible = True 'If you want Excel to be visible. Its invisible by default.
Else
XlOpen = True 'an indicator so we know whether to close Xl app or not when finished
End If
On Error GoTo 0
' Select Spreadsheet to extract data from
Dim objDialog, boolResult
Set objDialog = CreateObject("UserAccounts.CommonDialog")
objDialog.Filter = "Excel File|*.xls"
objDialog.FilterIndex = 1
' If no file is selected exit sub
boolResult = objDialog.ShowOpen
If boolResult = 0 Then
Exit Sub
End If
' Open or Activate the workbook
Dim fileName As String
If Not IsFileOpen(objDialog.fileName) Then
Set Wb = Xl.Workbooks.Open(objDialog.fileName)
Else
fileName = Right(objDialog.fileName, Len(objDialog.fileName) - _
InStrRev(objDialog.fileName, "\", -1, vbTextCompare))
Xl.Workbooks("sampleData.xls").Activate
Set Wb = Xl.ActiveWorkbook
End If

' Make Excel visible - comment this out when working
Xl.Visible = True


' CODE THAT ACTUALLY DOES THE STUFF YOU WANT HERE

CleanUp:
If XlOpen = False Then Xl.Quit 'close xl if we started it otherwise leave open
Set Xl = Nothing
Set Wb = Nothing

End Sub