Open Excel File and Write to it from Another VBA Application

Rekd

Banned
Joined
Apr 28, 2010
Messages
136
I'm looking for a way to open excel and write to it from another VBA enabled application. I can open the file I want using:
Code:
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.open ("C:\BoxSizes.xls")
And I can loop through the solidworks files using:

Code:
    strPath = "C:\Temp\"
    strFile = Dir(strPath)
    Do While strFile <> ""
        x = x + 1
 
            Debug.Print strFile
 
        strFile = Dir   ' Get next entry.
    Loop
But I'm not sure how to write the values I get from Solidworks into the cells.

Here's what I'm doing...

I created a macro in Solidworks (Uses the same VBA editor that Office uses) to loop through all the files in a folder and create a sort of bounding box around the part, (getting the length, width and height) then parsing the largest of the 3 for output to the Excel file with the file's name and some other config data.

The spreadsheet will look something like this:

<TABLE style="WIDTH: 298pt; BORDER-COLLAPSE: collapse" cellSpacing=0 cellPadding=0 width=396 border=0 x:str><COLGROUP><COL style="WIDTH: 86pt; mso-width-source: userset; mso-width-alt: 4169" width=114><COL style="WIDTH: 45pt; mso-width-source: userset; mso-width-alt: 2194" width=60><COL style="WIDTH: 40pt; mso-width-source: userset; mso-width-alt: 1938" width=53><COL style="WIDTH: 127pt; mso-width-source: userset; mso-width-alt: 6180" width=169><TBODY><TR style="HEIGHT: 14.25pt; mso-height-source: userset" height=19><TD class=xl22 style="BORDER-RIGHT: #e0dfe3; BORDER-TOP: #e0dfe3; BORDER-LEFT: #e0dfe3; WIDTH: 86pt; BORDER-BOTTOM: #e0dfe3; HEIGHT: 14.25pt; BACKGROUND-COLOR: transparent" width=114 height=19>File Name</TD><TD class=xl22 style="BORDER-RIGHT: #e0dfe3; BORDER-TOP: #e0dfe3; BORDER-LEFT: #e0dfe3; WIDTH: 45pt; BORDER-BOTTOM: #e0dfe3; BACKGROUND-COLOR: transparent" width=60>BSize</TD><TD class=xl22 style="BORDER-RIGHT: #e0dfe3; BORDER-TOP: #e0dfe3; BORDER-LEFT: #e0dfe3; WIDTH: 40pt; BORDER-BOTTOM: #e0dfe3; BACKGROUND-COLOR: transparent" width=53>Plating</TD><TD class=xl22 style="BORDER-RIGHT: #e0dfe3; BORDER-TOP: #e0dfe3; BORDER-LEFT: #e0dfe3; WIDTH: 127pt; BORDER-BOTTOM: #e0dfe3; BACKGROUND-COLOR: transparent" width=169>Description</TD></TR><TR style="HEIGHT: 14.25pt; mso-height-source: userset" height=19><TD class=xl22 style="BORDER-RIGHT: #e0dfe3; BORDER-TOP: #e0dfe3; BORDER-LEFT: #e0dfe3; BORDER-BOTTOM: #e0dfe3; HEIGHT: 14.25pt; BACKGROUND-COLOR: transparent" height=19>2526465101.sldprt</TD><TD class=xl22 style="BORDER-RIGHT: #e0dfe3; BORDER-TOP: #e0dfe3; BORDER-LEFT: #e0dfe3; BORDER-BOTTOM: #e0dfe3; BACKGROUND-COLOR: transparent" x:num="2.2559999999999998">2.256</TD><TD class=xl22 style="BORDER-RIGHT: #e0dfe3; BORDER-TOP: #e0dfe3; BORDER-LEFT: #e0dfe3; BORDER-BOTTOM: #e0dfe3; BACKGROUND-COLOR: transparent">PS1000</TD><TD class=xl23 style="BORDER-RIGHT: #e0dfe3; BORDER-TOP: #e0dfe3; BORDER-LEFT: #e0dfe3; BORDER-BOTTOM: #e0dfe3; BACKGROUND-COLOR: transparent">PLATE, DATUM, XY INPUT</TD></TR><TR style="HEIGHT: 14.25pt; mso-height-source: userset" height=19><TD class=xl22 style="BORDER-RIGHT: #e0dfe3; BORDER-TOP: #e0dfe3; BORDER-LEFT: #e0dfe3; BORDER-BOTTOM: #e0dfe3; HEIGHT: 14.25pt; BACKGROUND-COLOR: transparent" height=19>2526466101.sldprt</TD><TD class=xl22 style="BORDER-RIGHT: #e0dfe3; BORDER-TOP: #e0dfe3; BORDER-LEFT: #e0dfe3; BORDER-BOTTOM: #e0dfe3; BACKGROUND-COLOR: transparent" x:num="5.7560000000000002">5.756</TD><TD class=xl22 style="BORDER-RIGHT: #e0dfe3; BORDER-TOP: #e0dfe3; BORDER-LEFT: #e0dfe3; BORDER-BOTTOM: #e0dfe3; BACKGROUND-COLOR: transparent">PS1022</TD><TD class=xl23 style="BORDER-RIGHT: #e0dfe3; BORDER-TOP: #e0dfe3; BORDER-LEFT: #e0dfe3; BORDER-BOTTOM: #e0dfe3; BACKGROUND-COLOR: transparent">BAR, SUPPORT</TD></TR><TR style="HEIGHT: 14.25pt; mso-height-source: userset" height=19><TD class=xl22 style="BORDER-RIGHT: #e0dfe3; BORDER-TOP: #e0dfe3; BORDER-LEFT: #e0dfe3; BORDER-BOTTOM: #e0dfe3; HEIGHT: 14.25pt; BACKGROUND-COLOR: transparent" height=19>2526468101.sldprt</TD><TD class=xl22 style="BORDER-RIGHT: #e0dfe3; BORDER-TOP: #e0dfe3; BORDER-LEFT: #e0dfe3; BORDER-BOTTOM: #e0dfe3; BACKGROUND-COLOR: transparent" x:num>32.55</TD><TD class=xl22 style="BORDER-RIGHT: #e0dfe3; BORDER-TOP: #e0dfe3; BORDER-LEFT: #e0dfe3; BORDER-BOTTOM: #e0dfe3; BACKGROUND-COLOR: transparent">PS1022</TD><TD class=xl23 style="BORDER-RIGHT: #e0dfe3; BORDER-TOP: #e0dfe3; BORDER-LEFT: #e0dfe3; BORDER-BOTTOM: #e0dfe3; BACKGROUND-COLOR: transparent">HOUSING, INPUT XY</TD></TR></TBODY></TABLE>
TYIA
 
Last edited:

Some videos you may like

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.

Gary McMaster

Well-known Member
Joined
Feb 8, 2009
Messages
1,977
You could add something like the line in red to write the Excel File. If there can be more than one Excel file open you should replace the (1) with the name of the workbook and the name of the worksheet in quotes.

Gary

Code:
strPath = "C:\Temp\"
strFile = Dir(strPath)
Do While strFile <> ""
    x = x + 1
 
    Debug.Print strFile
    [COLOR=Red]objExcel.Workbooks(1).Worksheets(1).Range("A" & x).Value = strFile[/COLOR]
    'objExcel.Workbooks("MyBook").Worksheets("MySheet").Range("A" & x).Value = strFile
    
    strFile = Dir   ' Get next entry.
Loop
 

Rekd

Banned
Joined
Apr 28, 2010
Messages
136
You could add something like the line in red to write the Excel File. If there can be more than one Excel file open you should replace the (1) with the name of the workbook and the name of the worksheet in quotes.

Gary

Code:
strPath = "C:\Temp\"
strFile = Dir(strPath)
Do While strFile <> ""
    x = x + 1
 
    Debug.Print strFile
    [COLOR=red]objExcel.Workbooks(1).Worksheets(1).Range("A" & x).Value = strFile[/COLOR]
    'objExcel.Workbooks("MyBook").Worksheets("MySheet").Range("A" & x).Value = strFile
 
    strFile = Dir   ' Get next entry.
Loop
That worked. Thank you. It brought up another issue where I'm trying to get the last filled cell before I start writing so I don't overwrite what's already there. I tried

Code:
lLR = objExcel.Workbooks("BoxSizes").Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row ' Get number of rows in worksheet
But get a Subscript out of range error. Am I using the wrong Workbooks name? (The file is c:\BoxSizes.xls)

Thanks!
 

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
34,688
Office Version
365, 2019, 2016, 2010
Platform
Windows, MacOS
Add the .xls to the filename in your code.
 

Rekd

Banned
Joined
Apr 28, 2010
Messages
136
Add the .xls to the filename in your code.
I tried that originally, got an "object required" error.

Here's the entire script (I'm running this from Solidworks but stripped out the swAPP object so it should run fine in Excel's VBA) It errors when it gets to lLR = objExcel.Workbooks("blahblah...Row ' Get number of rows in worksheet

Code:
Sub LoopThruDirectory()
 
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.open ("C:\BoxSizes.xls")
Dim lLR As Long
Dim strPath As String
Dim strFile As String
Dim x As Integer
lLR = objExcel.Workbooks("BoxSizes.xls").Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row ' Get number of rows in worksheet
    strPath = "C:\Temp\"
    strFile = Dir(strPath)
    Do While strFile <> ""
                x = x + 1
    objExcel.Workbooks("BoxSizes.xls").Worksheets("Sheet1").Range("A" & x).Value = strFile
            Debug.Print strFile
        strFile = Dir   ' Get next entry.
    Loop
End Sub
Thanks for the help.
 

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
34,688
Office Version
365, 2019, 2016, 2010
Platform
Windows, MacOS
Do you have a reference set to the Excel object library? If not, xlUp has no value.
 

Rekd

Banned
Joined
Apr 28, 2010
Messages
136
Do you have a reference set to the Excel object library? If not, xlUp has no value.
I doubt it.

I'll look in the AM, time to start getting primed for the weekend. ;)

Thanks.
 

Rekd

Banned
Joined
Apr 28, 2010
Messages
136
Do you have a reference set to the Excel object library? If not, xlUp has no value.
I did not. I added the reference and stepped through and it worked. Then I ran it again in run mode and it choked with err 1004, Method 'Rows' of object '_Global' failed.

I figured it was hanging trying to open the book so I added a DoEvents after the Workbooks.Open command, then another before the xlUp command. (That's where it was hanging.)

That made it work if I stepped through holding my finger on F8 (where it wouldn't work before I added the DoEvents), but it still won't run using F5. Scratch that, a bit more testing and it chokes about every other time holding F8.

Should I put a timer in there or am I doing something wrong? Here's what I've got...

Code:
Option Explicit
Dim swApp As Object, objExcel As Object
Sub LoopThruDirectory()
Set swApp = Application.SldWorks
 
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.open ("C:\BoxSizes.xls")
DoEvents
Dim x As Long
Dim strPath As String
Dim strFile As String
DoEvents
x = objExcel.Workbooks("BoxSizes.xls").Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row ' Get number of rows in worksheet
    strPath = "C:\Temp\"
    strFile = Dir(strPath)
    Do While strFile <> ""
                x = x + 1
    objExcel.Workbooks("BoxSizes.xls").Worksheets("Sheet1").Range("A" & x).Value = strFile
            Debug.Print strFile
        strFile = Dir   ' Get next entry.
    Loop
End Sub
:mad:
 

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
34,688
Office Version
365, 2019, 2016, 2010
Platform
Windows, MacOS
Prefix the word Rows with objExcel. In other words:
Code:
objexcel.rows.count
 

Rekd

Banned
Joined
Apr 28, 2010
Messages
136
Oh, man! That's good stuff. Thank you very much.

You're good, you should be like an Excel MVP or something. :biggrin:
 
Last edited:

Forum statistics

Threads
1,089,490
Messages
5,408,575
Members
403,216
Latest member
Boba Fetts

This Week's Hot Topics

  • help please
    SORRY NOT ANY GOOD AT EXCEL SO HELP WOULD BE MUCH APPRECIATED this formula is in a sheet called ignore...
  • two formulas needed
    Hello, I'll try my best to explain this: First formula needed in Sheet1 cell A2: If Sheet1 cell B2 = Sheet2 cell B2 then return a 1. If not then...
  • Dynamic Counts
    Good afternoon, we are tidying up some data & the data seems to be growing quicker than we are tidying it up! What we confirm (by reviewing it...
  • Help Excel formula eliminate duplicate values and keep only 2 identical rows.
    as picture below column A has a duplicate value. but the values are not the same as the rule. sometimes 4 rows, sometimes 10 rows or 7 or 9...
  • Macro Compile Error Sub or Function not defined
    Hello, I am trying to run macros from a validation list, all macros have been created and run perfectly on there own but I'm getting a compile...
  • Last row combined with Current Region VBA
    I'm generally happy finding the last row of data through something like Lastrow = Cells(Rows.Count, "D").End(xlUp) but I don't always receive data...
Top