PDA

View Full Version : Solved: Import File Using Browser



SteveG
06-18-2007, 09:37 AM
Hi,

I have recorded a macro using the Macro recorder to import a file. The file location changes month to month and the name although it should be consistent may not be. Basically what I want to do is to create a macro to import the data where the user can browse the network for the file needed. Below is my current macro I recorded.


Sub ImportData()
'
' ImportData Macro
' Macro recorded 6/18/2007 by Administrator
'
'
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;G:\Business Planning Group\BPG MIS Reports\Monthly\SEC & NON-SEC Monthly Reports - CTN\CTN SEC & NON-SEC Source Data\June 2007\CTN SEC June 1-18 2007.csv" _
, Destination:=Range("A2"))
.Name = "CTN SEC June 1-18 2007_3"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 12
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 9, 9, 9, 9, 9, 9, 9, 9, _
9, 9, 9, 9, 9, 9, 9, 9, 9, 9)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub

I searched around the help files but couldn't find what I was looking for.

Thanks to all in advance for any assistance you can provide!

SteveG

Bob Phillips
06-18-2007, 09:57 AM
Sub ImportData()
Dim sFile As String

With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Filters.Add "Text files", "*.prn; *.txt; *.csv", 1
If .Show = -1 Then

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & .SelectedItems(1), Destination:=Range("A2"))
.Name = "CTN SEC June 1-18 2007_3"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 12
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 9, 9, 9, 9, 9, 9, 9, 9, _
9, 9, 9, 9, 9, 9, 9, 9, 9, 9)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End If
End With
End Sub

SteveG
06-18-2007, 10:32 AM
Thank you xld. That worked great.


Cheers,

SteveG

:beerchug:

SteveG
06-18-2007, 11:32 AM
Thanks for your help again xld. Just one more question that I can't figure out. I changed the code to identify the Destination as the ActiveCell so if I need to import mulitple files into the same tab I can select the cell where I want to begin the import. Is there a way to modify the code to import to the first empty cell in the range A7:A50000? So if I import a file into A7:A10000 (A7 being the first empty cell) and then import a second file it will automatically begin the import at A10001.

Sub ImportData()
Dim sFile As String

With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Filters.Add "Text files", "*.prn; *.txt; *.csv", 1
If .Show = -1 Then

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & .SelectedItems(1), Destination:=ActiveCell)
.Name = "CTN SEC June 1-18 2007_3"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 12
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 9, 9, 9, 9, 9, 9, 9, 9, _
9, 9, 9, 9, 9, 9, 9, 9, 9, 9)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End If
End With
End Sub



Thanks!

SteveG

Bob Phillips
06-18-2007, 01:56 PM
Sub ImportData()
Dim sFile As String

With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Filters.Add "Text files", "*.prn; *.txt; *.csv", 1
If .Show = -1 Then

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & .SelectedItems(1), Destination:=ActiveSheet.Range("A1").End(xlDown).Offset(1, 0))
.Name = "CTN SEC June 1-18 2007_3"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 12
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 9, 9, 9, 9, 9, 9, 9, 9, _
9, 9, 9, 9, 9, 9, 9, 9, 9, 9)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End If
End With
End Sub

SteveG
06-19-2007, 08:08 AM
xld,

Thanks for the new version of code. Instead of importing the second file below the first it shifts the first report to the right and imports into A7 again. I've tried altering the code a couple of different ways (ActiveSheet.Range, Offset) but can't seem to get it right. Any ideas?

Thanks again!

SteveG

SteveG
06-19-2007, 08:37 AM
Just a thought. Cells A1:A5 are empty. The import on the first file begins correctly on Cell A7. Could the fact that A1:A5 are empty be causing the error?

Bob Phillips
06-19-2007, 08:42 AM
Probably caused by blank cells. Try this version



Sub ImportData()
Dim sFile As String

With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Filters.Add "Text files", "*.prn; *.txt; *.csv", 1
If .Show = -1 Then

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & .SelectedItems(1), Destination:=ActiveSheet.Range("A" & ActiveSheet.Rows.Count).End(xlUp).Offset(1, 0))
.Name = "CTN SEC June 1-18 2007_3"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 12
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 9, 9, 9, 9, 9, 9, 9, 9, _
9, 9, 9, 9, 9, 9, 9, 9, 9, 9)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End If
End With
End Sub

Bob Phillips
06-19-2007, 08:44 AM
Just a thought. Cells A1:A5 are empty. The import on the first file begins correctly on Cell A7. Could the fact that A1:A5 are empty be causing the error?

LOL. Exactly the conclusion that I came to.

BTW, are you the same SteveG from the Microsoft forums?

SteveG
06-19-2007, 09:13 AM
After my last post I went in and put some values in A1:A5 and the code worked perfect. I then started to tinker with the code but you beat me to the fix. You're last revision worked like a charm. I'm just learning VBA and I'm not too sure footed yet so thanks for the help! In answer to your question, I'm sometimes on Exceltip.com but I haven't been in a while. I'm better with formulas and functions so I usually try to help folks out there if I can.

Thanks again!

Cheers,
SteveG

PWhatley
06-24-2007, 03:11 PM
Probably caused by blank cells. Try this version



Sub ImportData()
Dim sFile As String

With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Filters.Add "Text files", "*.prn; *.txt; *.csv", 1
If .Show = -1 Then

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & .SelectedItems(1), Destination:=ActiveSheet.Range("A" & ActiveSheet.Rows.Count).End(xlUp).Offset(1, 0))
.Name = "CTN SEC June 1-18 2007_3"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 12
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 9, 9, 9, 9, 9, 9, 9, 9, _
9, 9, 9, 9, 9, 9, 9, 9, 9, 9)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End If
End With
End Sub

Steve G, El Cid, etc.

I found your post very helpful for a similar project I am working on... However, the .Add Filter command I am using does not seem to work. When I click my VB button, the File Open dialog displays Microsoft Excel Files only in the pick list. It seems like a very simple command. What could I be doing wrong?

Here is my code..

On Error GoTo ImportTextFileError
Dim sFile As String
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Filters.Add "Text files", "*.prn; *.txt; *.csv", 1
If .Show = -1 Then

Thanks,

Paul

lucas
06-24-2007, 04:53 PM
I think something else must be causing it Paul. Try running your code like this:
Sub a()
On Error GoTo ImportTextFileError
Dim sFile As String
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Filters.Add "Text files", "*.prn; *.txt; *.csv", 1
If .Show = -1 Then
End If
End With
ImportTextFileError:
End Sub

PWhatley
06-24-2007, 07:43 PM
Many thanks. Lucas, but I could not detect much of a difference between what you had and what I had. I did remove blank lines and a few spaces, but seem to have the same results. Am I missing something else? Here is my entire code for that function:

Private Sub ImportTextFileMacroButton_Click()
On Error GoTo ImportTextFileError
Dim sFile As String
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Filters.Add "Text files", "*.prn; *.txt; *.csv", 1
If .Show = -1 Then
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & .SelectedItems(1), Destination:=ActiveSheet.Range("B" & ActiveSheet.Rows.Count).End(xlUp).Offset(1, 0))
.Name = "TEE-ACCOUNTER"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
'.RefreshStyle = xlInsertDeleteCells
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 12
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 9, 9, 9, 9, 9, 9, 9, 9, _
9, 9, 9, 9, 9, 9, 9, 9, 9, 9)
.TextFileTrailingMinusNumbers = True
ActiveSheet.Unprotect ("oleo2stk")
.Refresh BackgroundQuery:=False
ActiveSheet.Protect Password:="oleo2stk", AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowSorting:=True
.Delete
End With
End If
End With
Columns("B:AY").EntireColumn.AutoFit
Range("InputCell").Select
MsgBox "The selected JE Text File was successfully inported and column widths adjusted. Remember to modify your Input Table Headings to match your new import file columns, then click the T-Accounter ICON/Button to T-Account your JEs.", vbOKOnly, "Notice"
Exit Sub
ImportTextFileError:
MsgBox "File import aborted or unsuccessful. Please Try Again after deleting this blank sheet. Please note that T-Accounter requires Excel 2002 or later."
ActiveWorkbook.Unprotect
ActiveWindow.SelectedSheets.Delete
ActiveWorkbook.Protect Structure:=True, Windows:=False
End Sub

PWhatley
06-24-2007, 07:51 PM
Interesting, Lucas. I took the snippet you provided and put it into a new button in this workbook and it still provided a list of Excel files only. So then, I opened a new blank workbook and created a new button with just your snippet and got the same results.... Excel files only.

BTW, I am using Excel 2002. (10.6501.6735)SP3

Puzzled Paul.

PWhatley
06-24-2007, 08:23 PM
Possibly one more clue! I have THIS button that is supposed to provide for the import of delimited text files, and another button that is supposed to provide for the import of Excel files. When I use the button to open a fext file and manually change the file type in the file open dialog to *.txt/csv files, then when I use the button to open an Excel file, the file open dialog is set to *.txt/csv. The reverse happens as as well.

In other words once I manually set the file type in the file open dialog, it seems to stick until I manually change it again, regardless of what the filter is set to in the code. Oh well, bed time.

BTW, I noticed you are an Okie. Small world!

Thanks,
Paul

lucas
06-24-2007, 09:01 PM
BTW, I noticed you are an Okie. Small world!
Thanks,
Paul
I hadn't noticed that....yes it is a small world. There is only one other regular that is an okie that I know of...welcome to the board.


In other words once I manually set the file type in the file open dialog, it seems to stick until I manually change it again, regardless of what the filter is set to in the code. Oh well, bed time.
What happens if you open the workbook fresh and run your code from above?

lucas
06-24-2007, 09:06 PM
We'll have to apologize to SteveG...the original poster here for kinda hijacking his thread....it looked like he got an answer to his question but we should start a new thread for new questions.

PWhatley
06-25-2007, 04:25 AM
Apologies to Steve G. I am a Newbie and don't yet understand the protocol.

Opening and closing the workbook has no effect.

Paul

SteveG
07-11-2007, 11:17 AM
Paul,

No worries on the hijacking. Hope you were able to resolve your issue.

xld,

I have modified the code you helped me with (thank you again) to perform some additional functions (ClearData, QueryDelete & Insert NETWORKDAYS function). In addition I want to trim excess spaces from the range C7 to D5000 as the last part of the code. I have tried adding the Trim function as well as modifying the TrimExcess Spaces macro in the KB to no avail. Any suggestions would be much appreciated.


Sub Import()

Range("A7:E50000").Select
Selection.ClearContents
Selection.QueryTable.Delete
Range("F7:F5000").Select
Selection.SpecialCells(xlCellTypeFormulas, 23).Select
Selection.ClearContents
Dim sFile As String

With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Filters.Add "Text files", "*.prn; *.txt; *.csv", 1
If .Show = -1 Then

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & .SelectedItems(1), Destination:=ActiveSheet.Range("A" & ActiveSheet.Rows.Count).End(xlUp).Offset(1, 0))
.Name = "PRU CORRO DAILY WHITEMAIL"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 12
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 9, 9, 9, 9, 9, 9, 9, 9, _
9, 9, 9, 9, 9, 9, 9, 9, 9, 9)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
Range("F7").Select
Selection.FormulaR1C1 = "=NETWORKDAYS(RC[-4],R1C7,Holidays)"
Range("F7").Select
Selection.AutoFill Destination:=Range("F7:F5000")
End With
End If
End With
End Sub

Thanks!

Steve