import external data via macro/vba question
I'm trying to modify a macro to be more robust. What I
want is, with a target file open, to run a macro that will
open a source file and then perform a data import. I have
my modified code below, followed by the original
unmodified with clause.
My suspiscion is the problem lies in the .CommandText =
Array() line. The other possibility might be that the
focus is lost when I open the new file.
So 2 questions.
1) How should the .CommandText = Array() phrase look when
using a dynamic filename?
2) In general when dealing with multiple files in a macro,
how do you keep track and switch focus between them?
My experience with using data-import external data-
import data
is that it only works with the source file already open,
which is why I've added the open file routine at
the beginning of the macro.
Thanks for any help in advance.
Drabbacs
My experience with using data-import external data-
import data
is that it only works with the source file already open.
Code Follows
***Modified With Clause
Sub RTPdataimport()
Dim Filename1 As Variant
Filename1 = Application.GetOpenFilename
(filefilter:="Excel Files, *.xls", _
Title:="Pick a File")
If Filename1 = False Then
MsgBox "Ok, try later" 'user hit cancel
Exit Sub
End If
Workbooks.OpenText Filename:=Filename1 '....rest of
recorded code here!
With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=" "
"";User ID=Admin;Data Source=Filename1;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 L" _
, _
"ocking Mode=0;Jet OLEDB:Global Partial Bulk
Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New
Database Password="""";Jet OL" _
, _
"EDB:Create System Database=False;Jet
OLEDB:Encrypt Database=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(Filename1$)
.Name = Filename1
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = Filename1
.Refresh BackgroundQuery:=False
End With
***Original With Clause
With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=" "
"";User ID=Admin;Data Source=C:\Documents and
Settings\Administrator\My Documents\01re" _
, _
"qDB\RTP\RTP desktop lookahead sheets 2004\14 WEEK
LOOK AHEAD042004.xls;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 L" _
, _
"ocking Mode=0;Jet OLEDB:Global Partial Bulk
Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New
Database Password="""";Jet OL" _
, _
"EDB:Create System Database=False;Jet
OLEDB:Encrypt Database=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("'14 WEEK LOOK AHEAD042004$'")
.Name = "14 WEEK LOOK AHEAD042004"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = _
"C:\Documents and Settings\Administrator\My
Documents\01reqDB\RTP\RTP desktop lookahead sheets 2004\14
WEEK LOOK AHEAD042004.xls"
.Refresh BackgroundQuery:=False
End With
|