WORKS PERFECT EXCEPT FOR!!!!! PLEASE!!!

[DIVINEDAR0956]

The following procedure works perfect for opening any excel file in a directory. My only problem is that when you close the excel file and click the edit button again the excel form is underneath the desktop or any other application that may be open and does not appear even if you click the excel button on the status bar. The procedure is as follows:

Public Sub EditProjectNumber()
Dim xl As Object
Dim Wb As Object
Dim sht As Object
Set xl = Excel.Application
' If you want Excel to appear, use next line:
xl.Visible = True

xl.Dialogs(xlDialogOpen).Show "C:\Cost"
Set Wb = xl.ActiveWorkbook
Set sht = Wb.Sheets("PROJECT_INFORMATION&quot
End Sub

Question:

1.Is there any way to repaint or refresh this within the VB code so it will always appear at any time you click the button.

2. What is the code for updating links to the excel spreadsheet when you open a file? All the excel files are in the same format so they all have the same range name on each link.

3. Do I delete the link and do a code for transferspreadsheet? If so How do I tell the code to delete the link and redo the same link each time.

 

[VBslammer]

The problem you've described occurs when a modal error dialog halts execution of your code. It usually happens when you reference and invalid sheet name or range. Once your code runs normally without errors Excel will be open and available just like any other running application.

If your workbooks all have different sheet names to deal with you should query each workbook for available sheet names and present the user with a list of sheets to choose from so you don't get an invalid name.

Are you trying to link the spreadsheet just temporarily? Why would you want to delete and recreate the link? If the spreadsheet is linked to your database then its data will be current in the database each time you view it.

VBSlammer

 

[DIVINEDAR0956]

My hero to the rescue. Thank you. All of the excel spreadsheets have the same template. Set sht = Wb.Sheets("PROJECT_INFORMATION&quot is in every excel template. The excel template has approximately 60 sheets and the very first sheet is the project information sheet in every template. I tried setting it to the sheet number which is 51 but that is what gave me an error. I want it to come up to the Project Information sheet because if they save it as a different number when they enter the number into the project information sheet it changes in all the sheets. So you only have to put the number in cell A1 and it changes throughout the whole workbook.

The reason for the link of the spreadsheets is because each time they open a new workbook or to edit a workbook the links in access are not updated. I found the following but I'm not good at VB that understand everything it's telling me:

Sub RefreshLinkX()

Dim dbsCurrent As Database
Dim tdfLinked As TableDef

' Open a database to which a linked table can be
' appended.
Set dbsCurrent = OpenDatabase("DB1.mdb&quot

' Create a linked table that points to a Microsoft
' SQL Server database.
Set tdfLinked = _
dbsCurrent.CreateTableDef("AuthorsTable&quot
tdfLinked.Connect = _
"ODBC;DATABASE=pubs;UID=sa;PWD=;DSN=Publishers"
tdfLinked.SourceTableName = "authors"
dbsCurrent.TableDefs.Append tdfLinked

' Display contents of linked table.
Debug.Print _
"Data from linked table connected to first source:"
RefreshLinkOutput dbsCurrent

' Change connection information for linked table and
' refresh the connection in order to make the new data
' available.
tdfLinked.Connect = _
"ODBC;DATABASE=pubs;UID=sa;PWD=;DSN=NewPublishers"
tdfLinked.RefreshLink

' Display contents of linked table.
Debug.Print _
"Data from linked table connected to second source:"
RefreshLinkOutput dbsCurrent

' Delete linked table because this is a demonstration.
dbsCurrent.TableDefs.Delete tdfLinked.Name

dbsCurrent.Close

End Sub

Sub RefreshLinkOutput(dbsTemp As Database)

Dim rstRemote As Recordset
Dim intCount As Integer

' Open linked table.
Set rstRemote = _
dbsTemp.OpenRecordset("AuthorsTable&quot

intCount = 0

' Enumerate Recordset object, but stop at 50 records.
With rstRemote
Do While Not .EOF And intCount < 50
Debug.Print , .Fields(0), .Fields(1)
intCount = intCount + 1
.MoveNext
Loop
If Not .EOF Then Debug.Print , &quot;[more records]&quot;
.Close
End With

End Sub

For one thing I don't want it to print I just want it to update my links that already in access. I wish I could send you an example of my workbook so you can see what I'm talking about. I will be more than happy for your assistance in this matter. Like I said I'm up against a deadline on this and I think I've done pretty good to be a beginner in access. Look forward to hearing from you.

Darlene
dsippio@comtechsystems.com

 

[VBslammer]

The example code is aimed at refreshing linked table data from a SQL Server database.

Your problem seems to be more about using linked spreadsheets, which don't need to be 'connected to' in this way. Once you establish a link to a spreadsheet, your DB will be able to read its data just like it is an internally stored Access table. The only time you would have to 'Refresh' the link to the spreadsheet is if someone were to relocate the workbook file.

I'm not sure about your goal here but it looks like what you're trying to do is just append data from separate workbooks into a table in your database. If that's the case, then you don't need to link anything. You just want to do an import each time a user opens a workbook and adds data.

Example:

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "myTable", "C:\myTemplate.xls", True, "PROJECT_INFORMATION!A1"

The argument &quot;PROJECT_INFORMATION!A1&quot; is for the range to import, so if you have a specific range to import it's easiest to make a named range in your template and use it for the range argument: &quot;PROJECT_INFORMATION!MyRange&quot;

VBSlammer

 

[DIVINEDAR0956]

Thank you for your response. Yes that is what I want to do but I have one eenie bitty problem. This all works fine until:

Public Sub EditProjectNumber()
Dim xl As Object
Dim Wb As Object
Dim sht As Object
Dim strfile As Object
Set xl = Excel.Application

' If you want Excel to appear, use next line:
xl.Visible = True

xl.Dialogs(xlDialogOpen).Show &quot;C:\Cost\&quot;
DoCmd.RepaintObject
Set Wb = xl.ActiveWorkbook
Set sht = Wb.Sheets(&quot;PROJECT_INFORMATION&quot
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, &quot;PROJECT&quot;, &quot;C:\Cost\*.xls&quot;, True, &quot;PROJECT_EXTRACT&quot;
End Sub

This procedure, without the transferspreadsheet opens the excel file. How do I let the transferspreadsheet line know to use the file that I have open. Can I use a variable to recognize the file that choose to open if so how do I write that variable so it would recognize it.

Thank you.

 

[VBslammer]

The 'FullName' property of the Workbook returns the full path and filename for the workbook:

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "PROJECT", Wb.FullName, True, "PROJECT_EXTRACT"

VBSlammer

 

[DIVINEDAR0956]

VB,

That saves an entirely new workbook as Project.xls. What am I missing. I don't get an error message anymore though. I'm working on it too so please help.

 

[VBslammer]

Do you want your users to decide what the new name should be? If so you could just pop up an input box and let them name it, or you could append the time to the filename to make it unique. VBSlammer

 

[DIVINEDAR0956]

VB,

Even with the input box would that automatically link the spreadsheets to access.

Question for you? Can I do a macro that will link the incoming file and run the macro through VB.

 

[VBslammer]

I must be missing something in the translation. Are you linking mulitple worksheets to multiple corresponding local tables, or trying to link multiple worksheets to a single table?

I'm not aware of a way you can link multiple worksheets to a single table. You could link multiple workbooks to a master workbook via cell references and then use a sheet from the master workbook as a linked table in your DB.

A worksheet linked to your DB is nothing more than a virtual table. One source (the spreadsheet) and one destination (the local virtual table). Any data added to the spreadsheet is available to the database instantly.

I thought you were using a spreadsheet template as some kind of user input form, and then importing (appending) the data from that form into a known table.

If so, you just need to save each copy of the workbook, import its data and be done with it - no linking needed. You could even delete the spreadsheet after the import so the data doesn't get imported twice, or move it to an archive directory for backup purposes.

Let me know VBSlammer

 

[DIVINEDAR0956]

I must be missing something in the translation. Are you linking mulitple worksheets to multiple corresponding local tables, or trying to link multiple worksheets to a single table?

No. I am linking 5 sheets to 5 tables and all 5 sheets are in all the excel spreadsheets that are used. For instance I have a project information spreadsheet that connects to a project table in access, there's a vendor spreadsheet that connects to a vendor table in access, and so on.

I thought you were using a spreadsheet template as some kind of user input form, and then importing (appending) the data from that form into a known table.

Yes. I have one workbook that is a template and used to do new projects. I also have those projects that have been done and I would like for a user to be able to open it up, save it as another project, and the spreadsheets in the edit project to automatic link or update the tables within the access program.

If so, you just need to save each copy of the workbook, import its data and be done with it - no linking needed. You could even delete the spreadsheet after the import so the data doesn't get imported twice, or move it to an archive directory for backup purposes.

Yes. This is what I want to do for the edited projects. But my dilemma is figuring out how to put in VB code to link the tables from an edit project in excel to access without having &quot;ENGINEERS&quot; to do the linking themselves. I don't know if you ever worked with engineers but they are the worse to train to do anything because they know everything. In other words when they open the file or either close the excel file in an edit project file I want these tables to automatically link.

So instead of this part &quot;Wb.FullName&quot; making a new file is there a way to give the file that is open up for editing given a variable. Thank you for your help and I appreciate your brain.

 

[VBslammer]

If you want to fully automate Excel so you can tell what the engineers are doing, you can use a class module to capture Excel's events. That way when they save the file you'll have the new filename. Here's how I would do it:

'This is a form module's code:
Option Compare Database
Option Explicit

Private WithEvents xl As clsExcel

' button handler.
Private Sub cmdExcelClass_Click()
On Error GoTo ErrHandler
  
  Set xl = New clsExcel
  
  If Not xl Is Nothing Then
    While xl.Working
      DoEvents
    Wend
  End If

ExitHere:
  On Error Resume Next
  Set xl = Nothing
  Exit Sub
ErrHandler:
  MsgBox "Error: " & Err & " - " & Err.Description & vbCrLf & _
    "Caused by: cmdExcelClass( )"
  Resume ExitHere
End Sub

' inherited class event.
Private Sub xl_FileNameChanged(ByVal NewFileName As String)
  Call UpdateLink(NewFileName)
End Sub

Private Sub UpdateLink(ByVal strFileName As String)
  ' Add your TransferSpreadsheet code here...
End Sub

Here's the Class module:

'********************
'*
'*   FILENAME:     clsExcel.cls
'*   CREATED BY:   VBSlammer
'*   MODIFIED:     10/17/2002 12:17:36 AM - mds
'*   PURPOSE:      Automate Microsoft Excel
'*
'*   NOTES:        Original source code contained in this program
'*                 may not be reproduced without author's permission.
'*
'********************
Option Compare Database
Option Explicit

'********************
'*    Automation Variables
'********************
Private WithEvents xl As Excel.Application
Private WithEvents xlWB As Excel.Workbook

'********************
'*    Events
'********************
Public Event FileNameChanged(ByVal NewFileName As String)

'********************
'*    CommandBars
'********************
Private WithEvents cbFileNew As CommandBarButton
Private WithEvents cbFileOpen As CommandBarButton
Private WithEvents cbStdNew As CommandBarButton
Private WithEvents cbStdOpen As CommandBarButton

'********************
'*    Class Module Variables
'********************
Private mstrWBName As String
Private mstrSaveFileName As String
Private mblnDirty As Boolean
Private mblnWorking As Boolean

'********************
'*    CONSTRUCTOR
'********************
Private Sub Class_Initialize()
On Error GoTo ErrHandler
  Dim strDefaultPath As String
  
  ' Set initial path and file type.
  strDefaultPath = "C:\Documents and Settings\SysAdmin\My Documents\Excel\*.xlt"
  
  ' Start the automation.
  Set xl = New Excel.Application
  xl.Visible = True
  
  ' Let engineer choose file.
  xl.Dialogs(xlDialogOpen).Show strDefaultPath
  
  ' Capture WB. If user cancels will trigger error.
  Set xlWB = xl.ActiveWorkbook
  
  ' set working template name.
  WbFileName = xlWB.FullName
  
  ' Capture menu commands.
  With xl.CommandBars("File")
    Set cbFileNew = .Controls("New...")
    Set cbFileOpen = .Controls("Open...")
  End With
  With xl.CommandBars("Standard")
    Set cbStdNew = .Controls("New")
    Set cbStdOpen = .Controls("Open")
  End With
  
  cbFileNew.Visible = False
  cbFileOpen.Visible = False
  cbStdNew.Visible = False
  cbStdOpen.Visible = False
  
  ' set flag to show user is editing.
  Working = True
  
ExitHere:
  Exit Sub
ErrHandler:
  Select Case Err
    Case 0  ' Change to specific error number
      'Handle specific errors here
    Case Else
      Debug.Print Err.Number & " - " & Err.Description
      Resume ExitHere
  End Select
End Sub

'********************
'*    DESTRUCTOR
'********************
Private Sub Class_Terminate()
On Error Resume Next
  ' restore command buttons
  cbFileNew.Visible = True
  cbFileOpen.Visible = True
  cbStdNew.Visible = True
  cbStdOpen.Visible = True
  ' dereference
  Set cbFileNew = Nothing
  Set cbFileOpen = Nothing
  Set cbStdNew = Nothing
  Set cbStdOpen = Nothing
  Set xlWB = Nothing
  Set xl = Nothing
End Sub

'********************
'*    READ-ONLY PROPERTIES
'********************
Public Property Get WbFileName() As String
  WbFileName = mstrWBName
End Property

Private Property Let WbFileName(ByVal strFileName As String)
  mstrWBName = strFileName
End Property

Public Property Get SaveFileName() As String
  SaveFileName = mstrSaveFileName
End Property

Private Property Let SaveFileName(ByVal strFileName As String)
  mstrSaveFileName = strFileName
End Property

Public Property Get Working() As Boolean
  Working = mblnWorking
End Property

Private Property Let Working(ByVal blnWorking As Boolean)
  mblnWorking = blnWorking
End Property

'********************
'*    METHODS
'********************
Public Function SaveWorkBookAs() As String
On Error GoTo ErrHandler

  Dim varFileName As Variant
  Dim strDefaultName As String
  Dim strFilter As String
  Dim strTitle As String
  
  strDefaultName = "NewWorkbook " & Format(Date, "mm-dd-yy")
  strFilter = "Excel Files (*.xls), *.xls"
  
  ' Template name does not include extension
  If InStr(xlWB.FullName, ".") = 0 Then
    strTitle = "Save Template As..."
  Else
    strTitle = "Save Workbook As..."
  End If
  
  ' Reset save name property.
  SaveFileName = ""
  
  ' Let user choose save as directory.
  varFileName = xl.GetSaveAsFilename(strDefaultName, strFilter, , strTitle)
  
  ' If user didn't cancel...
  If varFileName <> False Then
    SaveFileName = varFileName
    xlWB.SaveAs SaveFileName
    ' let parent know the user changed the filename.
    RaiseEvent FileNameChanged(SaveFileName)
  End If
  
  SaveWorkBookAs = SaveFileName
  
ExitHere:
  Exit Function
ErrHandler:
  Debug.Print &quot;Error in SaveWorkBookAs(): &quot; & Err & &quot; - &quot; & Err.Description
  Resume ExitHere
End Function

'********************
'*   INHERITED EVENTS - COMMANDBAR CONTROLS
'********************
Private Sub cbFileNew_Click(ByVal Ctrl As Office.CommandBarButton, _
                                        CancelDefault As Boolean)
  ' Don't let user open a new workbook.
  Beep
  CancelDefault = True
End Sub

Private Sub cbFileOpen_Click(ByVal Ctrl As Office.CommandBarButton, _
                                        CancelDefault As Boolean)
  ' Don't let user open a workbook.
  Beep
  CancelDefault = True
End Sub

Private Sub cbStdNew_Click(ByVal Ctrl As Office.CommandBarButton, _
                                        CancelDefault As Boolean)
  ' Don't let user create a new workbook.
  Beep
  CancelDefault = True
End Sub

Private Sub cbStdOpen_Click(ByVal Ctrl As Office.CommandBarButton, _
                                        CancelDefault As Boolean)
  ' Don't let user open a workbook.
  Beep
  CancelDefault = True
End Sub

'********************
'*   INHERITED EVENTS - EXCEL APPLICATION
'********************
Private Sub xl_NewWorkbook(ByVal Wb As Excel.Workbook)
  ' Can't cancel, so close WB's opened with Ctrl+New
  Wb.Close
End Sub

Private Sub xl_SheetActivate(ByVal Sh As Object)
  ' add handler here
  xl.StatusBar = Sh.Name
End Sub

Private Sub xl_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)
  ' add handler here
End Sub

Private Sub xl_WorkbookBeforeClose(ByVal Wb As Excel.Workbook, Cancel As Boolean)
  ' add handler here
  Working = False
End Sub

Private Sub xl_WorkbookBeforePrint(ByVal Wb As Excel.Workbook, Cancel As Boolean)
  ' add handler here
  xl.StatusBar = &quot;This information is confidential, printing is forbidden!&quot;
  Cancel = True
End Sub

Private Sub xl_WorkbookBeforeSave(ByVal Wb As Excel.Workbook, _
                                    ByVal SaveAsUI As Boolean, Cancel As Boolean)
  ' If user is trying to save, cancel operation.
  If SaveAsUI Then
    Cancel = True
    Me.SaveWorkBookAs
  End If
End Sub

Private Sub xl_WorkbookNewSheet(ByVal Wb As Excel.Workbook, ByVal Sh As Object)
  ' add handler here
End Sub

Private Sub xl_WorkbookOpen(ByVal Wb As Excel.Workbook)
  ' add handler here
End Sub

'********************
'*    EOF
'********************

Feedback welcome

VBSlammer

 

[DIVINEDAR0956]

VB,

I understand the code but as you know I am pretty new to all of this and willing and eager to learn what I'm doing. WHAT IS A FORM MODULE? I've checked help and don't understand. Do I divide this code up and put one section in a class module (which I did) and the other in a form module (which I have no idea what it is). Once this is done do I do a macro to run the code (runcode). Again I understand your code but how do I make it work. Hope very much that I am not an inconvenience for you, but you have been so helpful and more understanding. Darlene Sippio
dsippio@comtechsystems.com

 

[DIVINEDAR0956]

VB,

Whenever I try to run the code I get an error here Private WithEvents xl As clsExcel . It said it is only to be used within an object module. When I include it inside the sub module code it doesn't work either. I'm new help me. Thank you. Darlene Sippio
dsippio@comtechsystems.com

 

[VBslammer]

The first part of the code (the button code) can be used with a form button on an Access Form. I named the button 'cmdExcelClass' but it can be whatever you want. The 'WithEvents' declaration should be at the top of the same module containing the button handler. Once you delcare the 'clsExcel' class using 'WithEvents' you inherit any events in the class (in this case the event you're after is the 'FileNameChanged' event) and you can access them using the object and procedure combo boxes just below the Visual basic toolbar in the IDE.

Once you declare the clsExcel class from a FORM's module you won't get an error message.

You can instantiate class modules in standard modules but you can't use 'WithEvents.' That's why it has to go in a form module.

You'll have to alter the path information in the class to suit your needs, or add another property for 'StartupPath' so you can change it at runtime.



VBSlammer