Waardenburg
New Member
- Joined
- Jul 21, 2010
- Messages
- 1
To link the content of several workbooks I import external data into a sheet. I would like to do this controlled via a macro.
The files are stored on a network server.
When using standard code the update is performed as expected:
Due to the fact that the files are stored on a network server, and the other users do have different drive mapping, I'd prefer to have a more generique solution by using a UNC path.
But using this, I always get error 1040, the object does not exist.
The following code is used:
Adding the standard parth - with a character attached to a drive - does result into exactly the same problem.
Hopefully there is some expertise available to solve this issue.
The files are stored on a network server.
When using standard code the update is performed as expected:
Code:
With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=K:\b. In- en verkoop\b. Bestelbon en factuurspecificatie\" _
, _
"Data\Klanten.xls;Mode=Share Deny Write;Extended Properties=""HDR=YES;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Je" _
, _
"t OLEDB:Database Password="""";Jet OLEDB:Engine Type=35;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet " _
, _
"OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Dat" _
, _
"abase=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _
), Destination:=Range("A1"))
.CommandType = xlCmdTable
.CommandText = Array("Sheet1$")
.Name = "Klanten"
.FieldNames = False
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = False
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = _
"K:\b. In- en verkoop\b. Bestelbon en factuurspecificatie\Data\Klanten.xls"
.Refresh BackgroundQuery:=False
Due to the fact that the files are stored on a network server, and the other users do have different drive mapping, I'd prefer to have a more generique solution by using a UNC path.
But using this, I always get error 1040, the object does not exist.
The following code is used:
Code:
Sub auto_open()
Dim sDirectory As String
Dim sfile As String
sDirectory = ActiveWorkbook.Path
sfile = sDirectory + "\Klanten.xls"
' Sheets("Klanten").Unprotect
sfile = Path2UNC(sfile)
Sheets("conf").Cells(5, 3).Value = sfile
Sheets("Klanten").Activate
On Error GoTo err_hndl1
With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=sfile;" _
, _
"Mode=Share Deny Write;Extended Properties=""HDR=YES;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet " _
, _
"OLEDB:Database Password="""";Jet OLEDB:Engine Type=35;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet " _
, _
"OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Dat" _
, _
"abase=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _
), Destination:=Range("A1"))
.CommandType = xlCmdTable
.CommandText = Array("Sheet1$")
.Name = "Klanten"
.FieldNames = False
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = Sheets("conf").Cells(5, 3)
.Refresh BackgroundQuery:=False
End With
' Sheets("Klanten").Protect DrawingObjects:=True, contents:=True, Scenarios:=True
Exit Sub
err_hndl1:
MsgBox ("Klant en leveranciersdata niet geupdate!")
End Sub
Function Path2UNC(sFullName As String) As String
Dim sDrive As String
Dim i As Long
sDrive = UCase(Left(sFullName, 2))
With CreateObject("WScript.Network").EnumNetworkDrives
For i = 0 To .Count - 1 Step 2
If .Item(i) = sDrive Then
Path2UNC = .Item(i + 1) & Mid(sFullName, 3)
Exit Function '--------------------------------------------->
End If
Next
End With
End Function
Adding the standard parth - with a character attached to a drive - does result into exactly the same problem.
Hopefully there is some expertise available to solve this issue.