Update data on a closed workbook?

[QuietRiot]

I created a form and the values that it takes are Date, Issue, Name, Team Member and Cause.

I use a Production Support Report (workbook that I don't want open for people to see) and it will have tabs for each month ie; January

how can I without opening Production Support Report grab the values from the form then update the Production support report by finding the months sheet and sticking the values at the last row.

 

[hirvenhuuli]

Hi Fazza,
Thanks for the sample. I did some tests of my own to come up with the following. This time, with early binding...

-----------------------------------------------
The following behavior was noted during my test:

1) Using a named range with update statements appears to be unpredictable as the named range
may be moved or lost. This should pose no problem with select queries.

2) Trying to use a single cell as a recordset fails, with or without headers. I found that in either case I could
reference the cell I am interested in updating, along with the cell below it or above it - in the latter case
"pretending" there is a header cell.

-- Alex
-----------------------------------------------


hirvenhuuli,
Please pay close attention to the comments at the beginning of the subroutine
about setting a reference to the ADO library.

Sub ChangeDataInSingleCell()
'---------------------------------
'USER: Please make sure you set references to the ADO object Library
'     1. In the Visual Basic window select Tools on the main menu
'     2.  Then from the Tools menu select References...
'     3.  Then click the box for Microsoft ActiveX Data Objects 2.8 or higher
'---------------------------------

Dim objRecordset As ADODB.Recordset
Dim stConn As String
Dim stSQL As String
Dim workbookVar As String
Dim strTarget As String 'Worksheet and cell address - in brackets with sheet name suffixed with a $
Dim newValueVar As Double

'-----
'Note:
'In referencing the sheet and cell to update,
'    we are interested in one cell.  But we "pretend" there is a
'    field header above it - ADO seems to require at least two cells
'-------------------------------------------------------------------
workbookVar = "C:\MyBook.xls"
strTarget = "[Sheet1$E3:E4]"
newValueVar = 2.7182

'Create the connection string.
stConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
workbookVar & ";Extended Properties=Excel 8.0;"
Debug.Print stConn

'Create the SQL query string
stSQL = "SELECT * FROM " & strTarget
Debug.Print stSQL

Set objRecordset = New ADODB.Recordset
Call objRecordset.Open(stSQL, stConn, CursorTypeEnum.adOpenDynamic, _
        LockTypeEnum.adLockOptimistic, CommandTypeEnum.adCmdText)

'Only one record to be updated
    If Not objRecordset.EOF Then
        objRecordset.Fields(0).Value = newValueVar
        objRecordset.Update
    End If

Set objRecordset = Nothing

End Sub

Hi Alexander, I tried your code. No error messages, but excel crashes after a while of non response. wondering if it could depend on the initially empty cells in the target sheet?

 

[xenou]

That should make no difference.

Here's another example to try - let's just make sure that connections, providers, etc. are all in order. This example will create its own workbook of source data, then query it and output to a new destination workbook.

Note: requires a reference to ADO library as in my earlier post.

Sub Test()
Dim ws As Worksheet
Dim rngCopyToCell As Range
Dim strSQL As String
Dim strConnection_String As String

    'To close Book1, Book2, etc. and create a test source
    Call TestBook
    Set ws = Workbooks.Add.Worksheets(1)
    
    'SQL String
    strSQL = _
    "SELECT Product, Sum(Sales) as TotalSales " _
    & "FROM myRange " _
    & "GROUP BY Product " _
    & "ORDER BY Product;"
    
    'Connection String to get data from an Excel file
    strConnection_String = _
    "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=C:\MySourceTest.xls;" & _
        "Extended Properties=Excel 8.0;"
    
    'Where to put the data
    Set rngCopyToCell = ws.Cells(1, 1)
    
    Call GetDataFromExcelFile(strConnection_String, strSQL, rngCopyToCell)

End Sub
'--------------------------------------------
Sub GetDataFromExcelFile(ByVal strConnection_String As String, ByVal strSQL As String, ByRef rngCopyToCell As Range)
'Creates a recordset from MDB database, using filter criteria from the calling sub
'Copies recordset to Cell A8 in worksheet referenced by the calling sub
Dim x As Long
Dim myRecordset As ADODB.Recordset
Set myRecordset = New ADODB.Recordset

    'sql string - uses module-level constants
    Debug.Print strSQL
    
    'initialize recordset and run the query
    Call myRecordset.Open(strSQL, strConnection_String, CursorTypeEnum.adOpenForwardOnly, _
        LockTypeEnum.adLockReadOnly, CommandTypeEnum.adCmdText)
    
    'Copy to worksheet (with headers)
    If Not myRecordset.EOF Then
        For x = 0 To myRecordset.Fields.Count - 1
            rngCopyToCell.Offset(0, x).Value = myRecordset.Fields(x).Name
        Next x
        Call rngCopyToCell.Offset(1, 0).CopyFromRecordset(myRecordset)
    End If
    
    'Close recordset object and release memory
    If (myRecordset.State And ObjectStateEnum.adStateOpen) Then myRecordset.Close
    Set myRecordset = Nothing

End Sub
'--------------------------------------------
Sub TestBook()
'Creates a test data source to query
Dim x As Long
Dim wb As Workbook
Dim blnExists
    
For Each wb In Workbooks
    If wb.Name = "MySourceTest.xls" Then
        blnExists = True
    End If
    If Left(wb.Name, 4) = "Book" Then
        wb.Close False
    End If
Next wb
    
If Not blnExists Then
    Set wb = Workbooks.Add
    wb.SaveAs Filename:="C:\MySourceTest.xls"
    With wb
        With Worksheets(1)
            .Cells(1, 1).Value = "Product"
            .Cells(1, 2).Value = "Store"
            .Cells(1, 3).Value = "Sales"
            For x = 2 To 21
                .Cells(x, 1).Value = "Product" & Int((9 - 1 + 1) * Rnd + 1)
                .Cells(x, 2).Value = x - 1
                .Cells(x, 3).Value = Int((150 - 100 + 1) * Rnd + 100)
            Next x
            .Range(.Cells(1, 1), .Cells(21, 3)).Name = "myRange"
        End With
        wb.Save
    End With

End If
End Sub

 

[hirvenhuuli]

That should make no difference.

Here's another example to try - let's just make sure that connections, providers, etc. are all in order. This example will create its own workbook of source data, then query it and output to a new destination workbook.

Note: requires a reference to ADO library as in my earlier post.

Sub Test()
Dim ws As Worksheet
Dim rngCopyToCell As Range
Dim strSQL As String
Dim strConnection_String As String

    'To close Book1, Book2, etc. and create a test source
    Call TestBook
    Set ws = Workbooks.Add.Worksheets(1)
    
    'SQL String
    strSQL = _
    "SELECT Product, Sum(Sales) as TotalSales " _
    & "FROM myRange " _
    & "GROUP BY Product " _
    & "ORDER BY Product;"
    
    'Connection String to get data from an Excel file
    strConnection_String = _
    "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=C:\MySourceTest.xls;" & _
        "Extended Properties=Excel 8.0;"
    
    'Where to put the data
    Set rngCopyToCell = ws.Cells(1, 1)
    
    Call GetDataFromExcelFile(strConnection_String, strSQL, rngCopyToCell)

End Sub
'--------------------------------------------
Sub GetDataFromExcelFile(ByVal strConnection_String As String, ByVal strSQL As String, ByRef rngCopyToCell As Range)
'Creates a recordset from MDB database, using filter criteria from the calling sub
'Copies recordset to Cell A8 in worksheet referenced by the calling sub
Dim x As Long
Dim myRecordset As ADODB.Recordset
Set myRecordset = New ADODB.Recordset

    'sql string - uses module-level constants
    Debug.Print strSQL
    
    'initialize recordset and run the query
    Call myRecordset.Open(strSQL, strConnection_String, CursorTypeEnum.adOpenForwardOnly, _
        LockTypeEnum.adLockReadOnly, CommandTypeEnum.adCmdText)
    
    'Copy to worksheet (with headers)
    If Not myRecordset.EOF Then
        For x = 0 To myRecordset.Fields.Count - 1
            rngCopyToCell.Offset(0, x).Value = myRecordset.Fields(x).Name
        Next x
        Call rngCopyToCell.Offset(1, 0).CopyFromRecordset(myRecordset)
    End If
    
    'Close recordset object and release memory
    If (myRecordset.State And ObjectStateEnum.adStateOpen) Then myRecordset.Close
    Set myRecordset = Nothing

End Sub
'--------------------------------------------
Sub TestBook()
'Creates a test data source to query
Dim x As Long
Dim wb As Workbook
Dim blnExists
    
For Each wb In Workbooks
    If wb.Name = "MySourceTest.xls" Then
        blnExists = True
    End If
    If Left(wb.Name, 4) = "Book" Then
        wb.Close False
    End If
Next wb
    
If Not blnExists Then
    Set wb = Workbooks.Add
    wb.SaveAs Filename:="C:\MySourceTest.xls"
    With wb
        With Worksheets(1)
            .Cells(1, 1).Value = "Product"
            .Cells(1, 2).Value = "Store"
            .Cells(1, 3).Value = "Sales"
            For x = 2 To 21
                .Cells(x, 1).Value = "Product" & Int((9 - 1 + 1) * Rnd + 1)
                .Cells(x, 2).Value = x - 1
                .Cells(x, 3).Value = Int((150 - 100 + 1) * Rnd + 100)
            Next x
            .Range(.Cells(1, 1), .Cells(21, 3)).Name = "myRange"
        End With
        wb.Save
    End With

End If
End Sub

tnx, will check that out to

 

[mlangen]

Interesting behavior, so this code has to have a header and a value "existing" in "C:\MyBook.xls" to update correct.

 

[Ida.]

Hi Guys,

I need your help regarding similar thing. I have the same issue, but with the chart (line chart).

How can I update chart on a closed workbook?