Re: $$Excel-Macros$$ prompting for files for data import

Wed, 05 Oct 2011 10:03:01 -0700

That can be done but it's probably easier to know the folder you need and modify my idea to suit 
Sub GetDataSAS()

'DATA_20110101, DATA_20110201
myfolder = "yourdriveletter:\yourfoldername\" 'these variables could be entered in a cell 
startname = "DATA_20110"
endname = "01"
For i = 1 To 3
mystring = myfolder & startname & i & endname
MsgBox mystring
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" _
& mystring & ".csv", Destination:=Range("A1"))

'your stuff
'copy needed range to other sheet

next i
end sub
-----Original Message----- From: Seba 
Sent: Wednesday, October 05, 2011 10:51 AM
To: MS EXCEL AND VBA MACROS
Subject: Re: $$Excel-Macros$$ prompting for files for data import

Thank you for your help, however, if I understand your suggestion
correctly, this would still open files from one and only location? In
my case, the source files are in different locations every month and
have different endings in their names: DATA_20110101, DATA_20110201,
etc...

That is why I need to be prompted to select the files manually.

On 5 okt., 16:56, "dguillett1" <dguille...@gmail.com> wrote:

The example you provide makes it fairly easy

for i= 1 to 3
Sheets("List" & 1).QueryTables.Add(Connection:= _
  "TEXT;Path to my file" & I &".csv", Destination:= sheets("List" &
1).range("a1")
'etc
next i
However, you can probably do it with ONE query table using the variables and 
have your macro copy only the desired data elsewhere.'
for i= 1 to 3
Sheets("sourcesheet").QueryTables.Add(Connection:= _
  "TEXT;Path to my file" & I &".csv", Destination:=
sheets("sourcesheet).range("a1")
'etc
copy range("a2:z4") sheets("destinationsheet").range("a1")

next i







-----Original Message-----
From: Seba
Sent: Wednesday, October 05, 2011 4:37 AM
To: MS EXCEL AND VBA MACROS
Subject: $$Excel-Macros$$ prompting for files for data import

Hi all,

I have to import data from 3 different files into 1 and format the
data. Since everything is more or less fixed, I have recorded the
macro below and removed the code for scrolling and such. The only
problem for me is that each month the locations and filenames of the
files to import are changing. What woudl the code be so the excel
prompts me for each file?

Thank you in advance for your help.

Code:

---------------------------------------------------------------------
Sub uvoz_podatkov()
'
' uvoz_podatkov Makro
'

'
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;Path to my file1.csv", Destination:= _
        Range("$A$1"))
        .Name = "MyFile1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 852
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

    Sheets("List2").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;Path to my file2.csv", Destination:= _
        Range("$A$1"))
        .Name = "MyFile2"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 852
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

    Sheets("List3").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;Path to my file3.csv", Destination:= _
        Range("$A$1"))
        .Name = "MyFile3"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 852
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

    Range("A:I,K:L").Select
    Range("K1").Activate

    Range("A:I,K:L,O:O,R:R,T:T,V:W,Y:Z").Select
    Range("Y1").Activate

    Range("A:I,K:L,O:O,R:R,T:T,V:W,Y:Z,AB:AC,AE:AF,AH:AI").Select
    Range("AH1").Activate

Range("A:I,K:L,O:O,R:R,T:T,V:W,Y:Z,AB:AC,AE:AF,AH:AI,AK:AN").Select
    Range("AK1").Activate
    Selection.Delete Shift:=xlToLeft

    Rows("1:1").Select
    Selection.AutoFilter
    Range("D:D,A:A").Select
    Range("A1").Activate
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With

    Sheets("List2").Select
    Columns("A:I").Select

    Range("A:I,N:N,R:R,T:U").Select
    Range("T1").Activate

    Range("A:I,N:N,R:R,T:U,W:X,Z:AA,AC:AD").Select
    Range("AC1").Activate

    Range("A:I,N:N,R:R,T:U,W:X,Z:AA,AC:AD,AF:AG,AI:AJ").Select
    Range("AI1").Activate

Range("A:I,N:N,R:R,T:U,W:X,Z:AA,AC:AD,AF:AG,AI:AJ,AL:AM,AO:AP,AR:AS").Select
    Range("AR1").Activate
    ActiveWindow.ScrollColumn = 36

Range("A:I,N:N,R:R,T:U,W:X,Z:AA,AC:AD,AF:AG,AI:AJ,AL:AM,AO:AP,AR:AS,AT:AU").
_
        Select
    Range("AT1").Activate
    Selection.Delete Shift:=xlToLeft

    Rows("1:1").Select
    Selection.AutoFilter
    Range("E:E,A:A").Select
    Range("A1").Activate
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With

    Sheets("List1").Select
    Range("A:B,C:C,D:I,K:K,N:N").Select
    Range("N1").Activate

    Range("A:B,C:C,D:I,K:K,N:N,Q:T").Select
    Range("Q1").Activate

    Range("A:B,C:C,D:I,K:K,N:N,Q:T,W:W,Y:Z,AB:AC,AE:AF").Select
    Range("AE1").Activate

Range("A:B,C:C,D:I,K:K,N:N,Q:T,W:W,Y:Z,AB:AC,AE:AF,AH:AI,AK:AL,AN:AO,AQ:AR").
_
        Select
    Range("AQ1").Activate

    Range( _

"A:B,C:C,D:I,K:K,N:N,Q:T,W:W,Y:Z,AB:AC,AE:AF,AH:AI,AK:AL,AN:AO,AQ:AR,AT:AX").
_
        Select
    Range("AT1").Activate
    Selection.Delete Shift:=xlToLeft

    Rows("1:1").Select
    Selection.AutoFilter
    Range("D:D,A:A").Select
    Range("A1").Activate
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
End Sub
-------------------------------------------------------------------------------------

--
----------------------------------------------------------------------------------
Some important links for excel users:
1. Follow us on TWITTER for tips tricks and links :http://twitter.com/exceldailytip 
2. Join our LinkedIN group @http://www.linkedin.com/groups?gid=1871310
3. Excel tutorials athttp://www.excel-macros.blogspot.com
4. Learn VBA Macros athttp://www.quickvba.blogspot.com
5. Excel Tips and Tricks athttp://exceldailytip.blogspot.com

To post to this group, send email to excel-macros@googlegroups.com

<><><><><><><><><><><><><><><><><><><><><><>
Like our page on facebook , Just follow below linkhttp://www.facebook.com/discussexcel 

--
----------------------------------------------------------------------------------
Some important links for excel users:
1. Follow us on TWITTER for tips tricks and links : http://twitter.com/exceldailytip 
2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
3. Excel tutorials at http://www.excel-macros.blogspot.com
4. Learn VBA Macros at http://www.quickvba.blogspot.com
5. Excel Tips and Tricks at http://exceldailytip.blogspot.com

To post to this group, send email to excel-macros@googlegroups.com

<><><><><><><><><><><><><><><><><><><><><><>
Like our page on facebook , Just follow below link
http://www.facebook.com/discussexcel 
--
----------------------------------------------------------------------------------
Some important links for excel users:
1. Follow us on TWITTER for tips tricks and links : 
http://twitter.com/exceldailytip
2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
3. Excel tutorials at http://www.excel-macros.blogspot.com
4. Learn VBA Macros at http://www.quickvba.blogspot.com
5. Excel Tips and Tricks at http://exceldailytip.blogspot.com

To post to this group, send email to excel-macros@googlegroups.com

<><><><><><><><><><><><><><><><><><><><><><>
Like our page on facebook , Just follow below link
http://www.facebook.com/discussexcel

Reply via email to