Links to named ranges don't update in database

  • Thread starter ragtopcaddy via AccessMonster.com
  • Start date
R

ragtopcaddy via AccessMonster.com

I'm trying to relink existing excel tables to new excel workbooks.

I successfully create new named ranges in the workbooks, and the aclink
command seems to work, but when I examine the excel links, they are still
linked to the old data. Here's my code:

Sub NewXLData()
Dim strXLDir As String
Dim rsTblNames As DAO.Recordset
Dim strSQL As String
Dim WkBk As Excel.Workbook
Dim WkSht As Excel.Worksheet
Dim rng As Excel.Range
Dim NmdRng As Excel.Name
Dim wkshtName As String
Dim rngName As String
Dim rngAddress As String
Dim fName As String
Dim dtWkBk As Date
Dim iTblID As Long
Dim lclName As String
Dim strConnect As String
Dim WkbkName As String

strSQL = "SELECT TBLID, WkbkName, lclName, CellTxt, RngNm, dtLastUpld" &
vbCrLf
strSQL = strSQL & "FROM tblXLNames" & vbCrLf
strSQL = strSQL & "ORDER BY SortOrd"

Set rsTblNames = dbLocal.OpenRecordset(strSQL)

If rsTblNames.EOF Or rsTblNames.BOF Then Exit Sub

strXLDir = Me.txtPath

If ExcelIsRunning Then
Set xlObj = GetObject(, "Excel.Application")
Else
Set xlObj = CreateObject("Excel.Application")
End If

With xlObj
.Visible = False
.ReferenceStyle = xlR1C1
End With

With rsTblNames
.MoveFirst
Do Until .EOF
WkbkName = Dir(strXLDir & .Fields("WkbkName"))
If Len(WkbkName) = 0 Then GoTo NextWkbk
fName = strXLDir & WkbkName
Set WkBk = xlObj.Workbooks.Open(fName)
dtWkBk = WkBk.BuiltinDocumentProperties("Creation Date")
' dtWkBk = FileDateTime(fName)
iTblID = .Fields("TBLID")
lclName = .Fields("lclName")
rngName = .Fields("RngNm")
' If .Fields("dtLastUpld") < dtWkBk Then
If .Fields("dtLastUpld") <> dtWkBk Then
Set WkSht = WkBk.ActiveSheet
wkshtName = WkSht.Name
xlObj.Cells.Find(.Fields("CellTxt")).Activate
xlObj.ReferenceStyle = xlR1C1
rngAddress = xlObj.ActiveCell.CurrentRegion.Address
(ReferenceStyle:=xlR1C1)
WkBk.Names.Add Name:=rngName, RefersToR1C1:="='" & wkshtName & "'!
" & rngAddress
WkBk.Close True
Set WkBk = Nothing

DropTable lclName

DoCmd.TransferSpreadsheet acLink, acSpreadsheetTypeExcel9,
lclName, fName, True, rngName

strSQL = "UPDATE tblXLNames SET dtLastUpld = #" & dtWkBk
strSQL = strSQL & "#, dtLastDwnld = #" & Now
strSQL = strSQL & "# WHERE TBLID=" & iTblID

dbLocal.Execute (strSQL)
SetIMEX2 1, lclName
Else
WkBk.Close True
Set WkBk = Nothing
End If
NextWkbk:
If Not .EOF Then .MoveNext
Loop
.Close
End With

Set rsTblNames = Nothing
Set WkSht = Nothing
Set WkBk = Nothing
Set xlObj = Nothing

EnableFtrCtrls

End Sub

Any help would be appreciated.
 
R

ragtopcaddy via AccessMonster.com

Here's the "DropTable" function:

Function DropTable(strTbl As String)

On Error Resume Next

DoCmd.RunSQL "drop table " & strTbl

On Error GoTo 0

End Function


When I look at the tables in the db window after running this, the xl table
is still there. What am I doing wrong here?

Thanks,
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top