Talking to Excel

I would like to transfer the following Excel sub (it works, already test it)
to MS Access. Could you please help me?

Thanks to All

Bre-x

Sub CombineWorkbooks()
Dim bfirst As Boolean, sPath As String
Dim sName As String, bk As Workbook
Dim bk1 As Workbook, sh As Object
bfirst = True
sPath = "N:\1CNCACCESSAPPS\AccessApps\exceltemp\john\"
sName = Dir(sPath & "*.xls")

Do While sName ""
Set bk = Workbooks.Open(sPath & sName)
Debug.Print bk.Name
If bfirst Then
bk.Sheets.Copy
bfirst = False
Set bk1 = ActiveWorkbook
Else
bk.Sheets.Copy After:=bk1.Sheets(bk1.Sheets.Count)
End If
bk.Close SaveChanges:=False
sName = Dir()
Loop

Application.DisplayAlerts = False
For Each sh In bk1.Sheets
If InStr(1, sh.Name, "summary", vbTextCompare) Or _
InStr(1, sh.Name, "tic&tie", vbTextCompare) Then
sh.Delete
End If
Next
Application.DisplayAlerts = True
End Sub

My Function on MS Access
----------------------------------------------------

Public Function copy_sheets(tcid As Double, tlid As Double, custid As
String, mach As Integer, prog As Integer)
'Dim string Variables
Dim thepath, bfirst As Boolean, sPath As String, sName As String
Dim bk As Workbook
Dim bk1 As Workbook
Dim sh As Object


'Set Variables
thepath = mypath & mach & "\" & custid & "\" & mach & prog & ".xls"

'Set bk = CreateObject("Excel.Application")
'Set bk1 = CreateObject("Excel.Application")

bfirst = True
sPath = "N:\1CNCACCESSAPPS\AccessApps\exceltemp\john\"
sName = Dir(sPath & "*.xls")

Do While sName ""
Set bk = Workbooks.Open(sPath & sName)
Debug.Print bk.Name
If bfirst Then
bk.Sheets.Copy
bfirst = False
Set bk1 = ActiveWorkbook
Else
bk.Sheets.Copy After:=bk1.Sheets(bk1.Sheets.Count)
End If
bk.Close SaveChanges:=False
sName = Dir()
Loop

With bk1.Application
..Visible = True
..DisplayAlerts = False
For Each sh In .Sheets
If InStr(1, sh.Name, "summary", vbTextCompare) Or _
InStr(1, sh.Name, "tic&tie", vbTextCompare) Then
sh.Delete
End If
Next
.DisplayAlerts = True
End With
End Function

On Thu, 29 Jan 2009 13:12:13 -0700, "Bre-x" wrote:

I would like to transfer the following Excel sub (it works, already test it)
to MS Access. Could you please help me?


Since Access doesn't have workbooks or sheets, and since it is a relational
database application rather than a spreadsheet (and thereby requires different
logic), it would really be much easier to rebuild it from scratch. For one
thing you would not loop through rows searching for names, you'ld use a Query.

What is this code intended to *ACCOMPLISH*?
--

John W. Vinson [MVP]

Sorry, I didn't explain my self very well.

We have a MS Access database that keeps track of hundred of thousands "CNC
Program Records".
Each record has a Mach ID and Program ID, Work Center ID, and a list of
Mastercam Tools.

Each record is send to an Excel Sheet where notes, pictures and diagrams are
add it. Then printed and give to the Machine Operator.

Each Excel Sheet is fully link and control on MS Access.

We have been using this system since 2002 and works very well for us.

I was ask if we can conbine several Excel sheets into one single Workbook,
and I would like to do it from ms access.

Thank you once again

Bre-x

On Thu, 29 Jan 2009 15:14:53 -0700, "Bre-x" wrote:

I was ask if we can conbine several Excel sheets into one single Workbook,
and I would like to do it from ms access.

Sorry... I did misinterpret.

You'll need to use Excel automation, a subject in which I am NOT at all well
versed. If you do that you can run your Excel macro natively in Excel, and not
need to rewrite it at all. I'll bring up this thread to the other MVP's and
see if someone more knowledgable can help!

--

John W. Vinson [MVP]

I can't test it, but this looks about right.

BTW, myPath is not defined so will be null.

Public Function copy_sheets(tcid As Double, _
tlid As Double, _
custid As String, _
mach As Long, _
prog As Long)
'Dim string Variables
Dim thepath, bfirst As Boolean, sPath As String, sName As String
Dim xlApp As Object
Dim bk As Object
Dim bk1 As Object
Dim sh As Object

'Set Variables
thepath = mypath & mach & "\" & custid & "\" & mach & prog & ".xls"

Set xlApp = CreateObject("Excel.Application")
With xlApp

.Visible = True
.DisplayAlerts = False
End With

bfirst = True
sPath = "N:\1CNCACCESSAPPS\AccessApps\exceltemp\john\"
sName = Dir(sPath & "*.xls")

Do While sName ""

Set bk = Workbooks.Open(sPath & sName)
Debug.Print bk.Name
If bfirst Then

bk.Sheets.Copy
bfirst = False
Set bk1 = ActiveWorkbook
Else

bk.Sheets.Copy After:=bk1.Sheets(bk1.Sheets.Count)
End If

bk.Close SaveChanges:=False
sName = Dir()
Loop

With bk1

For Each sh In .Worksheets

If InStr(1, sh.Name, "summary", vbTextCompare) Or _
InStr(1, sh.Name, "tic&tie", vbTextCompare) Then

sh.Delete
End If
Next
End With

xlApp.DisplayAlerts = True
Set xlApp = Nothing
xlApp.Quit
End Function

--
__________________________________
HTH

Bob

"Bre-x" wrote in message
...
Sorry, I didn't explain my self very well.

We have a MS Access database that keeps track of hundred of thousands "CNC
Program Records".
Each record has a Mach ID and Program ID, Work Center ID, and a list of
Mastercam Tools.

Each record is send to an Excel Sheet where notes, pictures and diagrams
are add it. Then printed and give to the Machine Operator.

Each Excel Sheet is fully link and control on MS Access.

We have been using this system since 2002 and works very well for us.

I was ask if we can conbine several Excel sheets into one single Workbook,
and I would like to do it from ms access.

Thank you once again

Bre-x

Hi Bre-x,

I am assuming that your final goal is to combine all the data from each
sheet into one table in Access... if this is the case...

you have 2 options:
1. make a table in Access with the desired structure
2. look at each sheet to make sure it has what you are looking for and,
if so, transfer the data on the sheet to the table
OR
1. import each worksheet that has what you are looking for as a separate
table in Access, then write additional code to combine them

I did not finish the code because I do not know which option you want,
nor do I know what to look for in the Excel sheet to make sure it has
what you are looking for ... but here is some 'shell' code:

'~~~~~~~~~~~~~~~~~~~~~~~~~~
Function TransferExcelSheetsToTable()
'currently, this only counts
' it loops through Excel files in a specified directory
' opens each workbook, and counts the sheets


'Crystal
'strive4peace2006 at yahoo dot com

On Error GoTo Proc_Err

TransferExcelSheetsToTable = False

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'~~~~~~~~~~~comment one of these blocks

'--- early binding -- use to develop
Dim xlApp As Excel.Application _
, xlWb As Excel.workbook _
, xlWs As Excel.Worksheet

' '--- late binding -- use to deploy
' Dim xlApp As Excel.Application _
' , xlWb As Excel.workbook _
' , xlSh As Excel.Worksheet
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Dim booLeaveOpen As Boolean _
, arrFile() As String _
, i As Integer _
, mNumSheets As Integer _
, mNumSheetsTotal As Integer _
, mNumFiles As Integer _
, mPath As String

mPath = "N:\1CNCACCESSAPPS\AccessApps\exceltemp\john\"

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Load filenames into an array
i = 1
ReDim arrFile(1)
arrFile(1) = Dir(mPath & "*.xls")

Do While arrFile(i) ""
If (GetAttr(mPath & "\" & arrFile(i)) _
And vbDirectory) vbDirectory Then
i = i + 1
ReDim Preserve arrFile(i)
arrFile(i) = Dir()
End If
Loop

'remove last entry which is blank
If i 1 Then ReDim Preserve arrFile(i - 1)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

If Not UBound(arrFile) 0 Then
MsgBox "There are no files to read for " _
& mPath _
, , "No Files"""
GoTo Proc_Exit
End If
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

'if Excel is already open, use that instance
booLeaveOpen = True

'attempting to use something that is not available
'will generate an error
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
On Error GoTo Proc_Err

'If xlApp is defined, then we
'already have a conversation
If TypeName(xlApp) = "Nothing" Then
booLeaveOpen = False
'Excel was not open -- create a new instance
Set xlApp = CreateObject("Excel.Application")
End If

mNumFiles = 0
mNumSheetsTotal = 0

For i = 1 To UBound(arrFile)

Debug.Print arrFile(i);

'don't update links, open as read-0nly
Set xlWb = xlApp.Workbooks.Open( _
mPath & arrFile(i), False, True)

mNumFiles = mNumFiles + 1

mNumSheets = 0

If xlWb.Worksheets.Count = 0 Then
GoTo NextWorkbook
End If

For Each xlWs In xlWb.Worksheets

' set up a table in Access
' and compare the structure of sheet to make sure it is right
' then transfer the data
' or
' import all the sheets as separate tables and then do stuff

'all this does right now is count ...

mNumSheets = mNumSheets + 1
Next xlWs

Debug.Print " --" & i & " worksheets"
mNumSheetsTotal = mNumSheetsTotal _
+ mNumSheets

NextWorkbook:

xlWb.Close False
Next i

MsgBox "Transferred data from " _
& mNumSheetsTotal & " worksheets" _
& " in " & mNumFiles & " Files" _
, , "Done"

TransferExcelSheetsToTable = True

Proc_Exit:
On Error Resume Next
Set xlWs = Nothing
If Not xlWb Is Nothing Then
xlWb.Close False
Set xlWb = Nothing
End If

If TypeName(xlApp) "Nothing" Then
xlApp.ActiveWorkbook.Close False
If Not booLeaveOpen Then xlApp.Quit
Set xlApp = Nothing
End If

Exit Function

Proc_Err:
MsgBox Err.Description, , _
"ERROR " & Err.Number _
& " TransferExcelSheetsToTable "

Resume Proc_Exit
'if you want to single-step code to find error, CTRL-Break at MsgBox
'then set this to be the next statement
Resume
End Function
'~~~~~~~~~~~~~~~~~~~~~~~~




Warm Regards,
Crystal
remote programming and training

Video Tutorials on YouTube!
http://www.youtube.com/user/LearnAccessByCrystal

Access Basics
8-part free tutorial that covers essentials in Access
http://www.AccessMVP.com/strive4peace

*
(: have an awesome day
*





Bre-x wrote:
Sorry, I didn't explain my self very well.

We have a MS Access database that keeps track of hundred of thousands "CNC
Program Records".
Each record has a Mach ID and Program ID, Work Center ID, and a list of
Mastercam Tools.

Each record is send to an Excel Sheet where notes, pictures and diagrams are
add it. Then printed and give to the Machine Operator.

Each Excel Sheet is fully link and control on MS Access.

We have been using this system since 2002 and works very well for us.

I was ask if we can conbine several Excel sheets into one single Workbook,
and I would like to do it from ms access.

Thank you once again

Bre-x

Hi Crystal,

I am assuming that your final goal is to combine all the data from each
sheet into one table in Access...

My interpretation is that Bre-x wants to combine all the data from each
sheet, in several Excel files, into one workbook in Excel using VBA code
within an Access application. His/her function likely references values in a
table, such as "tcid", "tlid", "custid", "mach" and "prog".

Bre-x:

As Bob Phillips points out, "myPath is not defined so will be null". I've
put together a test subroutine, along with a revised function that sets
mypath. You should immediately change an option in the Visual Basic Editor
(VBE) to Require Variable Declaration, as mypath was initially an undeclared
variable. See this article for more discussion:

Always Use Option Explicit
http://www.access.qbuilt.com/html/ge...tml#VBEOptions

Here is a start, although you've got more work to do. I was able to get this
function to combine worksheets from source Excel files, into one file, and
delete the appropriate sheets ("summary" and "tic&tie"). Your code, as
written, skips the first Excel file found by the DIR function. I'm not sure
if that is what you intended or not.

Sub TestIT()

Call copy_sheets(1, 1, "123", 2, 2)

End Sub

Public Function copy_sheets( _
tcid As Double, _
tlid As Double, _
custid As String, _
mach As Integer, _
prog As Integer)

Dim thepath As String
Dim sPath As String
Dim bfirst As Boolean
Dim sName As String
Dim bk As Workbook
Dim bk1 As Workbook
Dim sh As Object
Dim mypath As String


'Set Variables
mypath = "G:\Temp\Combined\"
thepath = mypath & mach & "\" & custid & "\" & mach & prog & ".xls"

Set bk1 = Workbooks.Open(thepath)

bfirst = True
sPath = "N:\1CNCACCESSAPPS\AccessApps\exceltemp\john\"
sPath = "G:\Temp\"
sName = Dir(sPath & "*.xls")

Do While sName ""
Set bk = Workbooks.Open(sPath & sName)
Debug.Print bk.Name

If bfirst Then
bk.Sheets.Copy
bfirst = False
Set bk = ActiveWorkbook
Else
bk.Sheets.Copy After:=bk1.Sheets(bk1.Sheets.Count)
End If
bk.Close SaveChanges:=False
sName = Dir()
Loop

With bk1.Application
.Visible = True
.DisplayAlerts = False
For Each sh In .Sheets
If InStr(1, sh.Name, "summary", vbTextCompare) Or _
InStr(1, sh.Name, "tic&tie", vbTextCompare) Then
sh.Delete
End If
Next sh
.DisplayAlerts = True
End With

End Function


When testing, make sure to periodically open up Task Manager
(Ctrl-Alt-Delete) and End Process on copies of Excel that should not be
running. That's the part that I was alluding to above, when I said that you
have more work to do.


Tom Wickerath
Microsoft Access MVP
http://www.accessmvp.com/TWickerath/
http://www.access.qbuilt.com/html/ex...tributors.html

Hello!

Set bk = Workbooks.Open(sPath & sName)

That doesn't work in Access, you need a qualified Excel Application, e.g.,
xlVariable.Workbooks.Etc... I.e., you're actually hanging Excel in memory.

You can't use ActiveWorkbook, either. xlApp.Workbooks(1) works.

Workbooks don't have Applications. While they might, they shouldn't, they
have Worksheets. They also have a Parent, the Application. Just use the
Application Variable, it controls both Workbooks, you're only using one
Application Instance.
--
Regards,
Nate Oliver
Microsoft Excel MVP


"Bre-x" wrote in message
...
I would like to transfer the following Excel sub (it works, already test
it) to MS Access. Could you please help me?

Thanks to All

Bre-x

Sub CombineWorkbooks()
Dim bfirst As Boolean, sPath As String
Dim sName As String, bk As Workbook
Dim bk1 As Workbook, sh As Object
bfirst = True
sPath = "N:\1CNCACCESSAPPS\AccessApps\exceltemp\john\"
sName = Dir(sPath & "*.xls")

Do While sName ""
Set bk = Workbooks.Open(sPath & sName)
Debug.Print bk.Name
If bfirst Then
bk.Sheets.Copy
bfirst = False
Set bk1 = ActiveWorkbook
Else
bk.Sheets.Copy After:=bk1.Sheets(bk1.Sheets.Count)
End If
bk.Close SaveChanges:=False
sName = Dir()
Loop

Application.DisplayAlerts = False
For Each sh In bk1.Sheets
If InStr(1, sh.Name, "summary", vbTextCompare) Or _
InStr(1, sh.Name, "tic&tie", vbTextCompare) Then
sh.Delete
End If
Next
Application.DisplayAlerts = True
End Sub

My Function on MS Access
----------------------------------------------------

Public Function copy_sheets(tcid As Double, tlid As Double, custid As
String, mach As Integer, prog As Integer)
'Dim string Variables
Dim thepath, bfirst As Boolean, sPath As String, sName As String
Dim bk As Workbook
Dim bk1 As Workbook
Dim sh As Object


'Set Variables
thepath = mypath & mach & "\" & custid & "\" & mach & prog & ".xls"

'Set bk = CreateObject("Excel.Application")
'Set bk1 = CreateObject("Excel.Application")

bfirst = True
sPath = "N:\1CNCACCESSAPPS\AccessApps\exceltemp\john\"
sName = Dir(sPath & "*.xls")

Do While sName ""
Set bk = Workbooks.Open(sPath & sName)
Debug.Print bk.Name
If bfirst Then
bk.Sheets.Copy
bfirst = False
Set bk1 = ActiveWorkbook
Else
bk.Sheets.Copy After:=bk1.Sheets(bk1.Sheets.Count)
End If
bk.Close SaveChanges:=False
sName = Dir()
Loop

With bk1.Application
.Visible = True
.DisplayAlerts = False
For Each sh In .Sheets
If InStr(1, sh.Name, "summary", vbTextCompare) Or _
InStr(1, sh.Name, "tic&tie", vbTextCompare) Then
sh.Delete
End If
Next
.DisplayAlerts = True
End With
End Function

Hi Nate,

That doesn't work in Access, you need a qualified Excel Application, e.g.,
xlVariable.Workbooks.Etc... I.e., you're actually hanging Excel in memory.

Ahhh....that likely explains why I had to End Task on Excel a few times,
while working up the start of a procedure I just posted.


Tom Wickerath
Microsoft Access MVP
http://www.accessmvp.com/TWickerath/
http://www.access.qbuilt.com/html/ex...tributors.html
__________________________________________

"Nate Oliver" wrote:

Hello!

Set bk = Workbooks.Open(sPath & sName)

That doesn't work in Access, you need a qualified Excel Application, e.g.,
xlVariable.Workbooks.Etc... I.e., you're actually hanging Excel in memory.

You can't use ActiveWorkbook, either. xlApp.Workbooks(1) works.

Workbooks don't have Applications. While they might, they shouldn't, they
have Worksheets. They also have a Parent, the Application. Just use the
Application Variable, it controls both Workbooks, you're only using one
Application Instance.
--
Regards,
Nate Oliver
Microsoft Excel MVP

Yes, sir. Works (or not so much) every time. You think it works once, not so
much after that!

It's kind of bad behavior on VBA's part, it looks like it works, but under
the hood, not working that well. It sets a General reference to an
unidentifiable instance of Excel, and can't resolve it, should you try your
madness, again.
--
Regards,
Nate Oliver
Microsoft Excel MVP

"Tom Wickerath" AOS168b AT comcast DOT net wrote in message
...
Hi Nate,

That doesn't work in Access, you need a qualified Excel Application,
e.g.,
xlVariable.Workbooks.Etc... I.e., you're actually hanging Excel in
memory.

Ahhh....that likely explains why I had to End Task on Excel a few times,
while working up the start of a procedure I just posted.


Tom Wickerath
Microsoft Access MVP
http://www.accessmvp.com/TWickerath/
http://www.access.qbuilt.com/html/ex...tributors.html
__________________________________________

"Nate Oliver" wrote:

Hello!

Set bk = Workbooks.Open(sPath & sName)

That doesn't work in Access, you need a qualified Excel Application,
e.g.,
xlVariable.Workbooks.Etc... I.e., you're actually hanging Excel in
memory.

You can't use ActiveWorkbook, either. xlApp.Workbooks(1) works.

Workbooks don't have Applications. While they might, they shouldn't, they
have Worksheets. They also have a Parent, the Application. Just use the
Application Variable, it controls both Workbooks, you're only using one
Application Instance.
--
Regards,
Nate Oliver
Microsoft Excel MVP