VBA Tips - Import A Text File

hello all,

I am back with a new problem. I have a workbook with many spreadsheet named Sheet1, Sheet2 and so on. Each sheet is filled completely upto 65536 rows. This data is being picked up from a CSV file. In this file there are sites with each site there is a assciated set of data. What happens is the data that extracts data does not differntiate between sites and when it reaches to the end of worksheet it splits the data into next sheet. So I am trying to create a macro to check each spreadsheet starting with the last sheet in the work book for example last sheet in the workbook is seven it should go to sheet6 and if there is a blank row after row 64000 it should cut all the rows and move them to sheet7. Then it should goto sheet5 and do the same and keep on doing it until it reaches sheet1. Can anyone help me out with this. Thanks in advance.


Amir

I'm sorry for the long intro, but problems are allways hard to describe.

I have been working on a macro to import text data files to a worksheet with the name of the text file (as it hold the date of the file in the name), and surprise, I'm not getting there wherre I like to.

Well, I've reached to get all data imported into the same worksheet, but then I am stuck as there are sometimes 7 files to import and sometimes 14 or 21,... you get the picture.

If it would be possible to place each imported file into a different worksheet, then I could continue to add a new macro to make the charts, but that should not be a problem.

Here's the macro, any ideas?

Sub Chimneydata()
Dim x As Integer
Dim fpath As String
Dim fname As String
x = 0
fpath = "c:\Documents and Settings\cdenys.IBANT\Desktop\Chimney\"
fname = Dir(fpath & "*.*")
While (Len(fname) > 0)
x = x + 1
Sheets("Sheet" & "").Select
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" _
& fpath & fname, Destination:=Range("A2"))
.Name = "a" & ""
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(9, 9, 1, 9, 9, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
fname = Dir
End With
Wend
End Sub

We are migrating users from Novell server to Microsoft and we must
preserve their drive mappings.

I have a spreadsheet which lists between say 1 and 75 user names. I
have drive mapping files associated with most user names that indicates
which drive mappings the user has set up on their machine. I would
like from Excel to (the cell addresses and directory names are little
changed from actual specific needs):

1. Create a batch file which takes the user names starting from cell
D47 say up to cell D122 appends ".txt" to the end of the user name.

2. The batch file would then look for a text file by by each user name
in the say H:\DriveMappings Directory and concatenates all the text
files in one file say "all.txt." This process should not stop if Excel
can't find a file with the name of say username1.txt, but should just
continue to the next one.*

3. Lastly the macro should paste this into say cell K251 by way of the
text import wizard and to use spaces and colons (":") to parse the data
into 3 columns while leaving the the 4th and 5th column un-imported,
since these columns contain non-essential inofrmation such as "Netware"
or "Microsoft Server." *

*I just found out that a copy command could work for the concatenation,
for instance:

H:\>copy pinchpa.txt+sortgr.txt+h235gz1.txt all.txt

However this command seems to fail if "DOS" can't find one of the
files.

**Note, each drive line is preceded in the drive mapping file by the
user names so it would be in the in the form:

pinchpa H: \\change05.net.company.org\gz_inc Netware
pinchpa I: \\change05.net.company.org\st_inc Microsoft Server
pinchpa S: \\change05.net.company.org\gz_inc_shared

etc.

Thanks much for any help!

It is not necessary for the colon to remain in the final data.

I've picked up this code from search your forum and it works perfectly until it comes across a file name with spaces in.

http://www.erlandsendata.no/english/...acimportadotxt

For example this works fine:

GetTextFileData "SELECT * FROM filename.txt WHERE fieldname = 'criteria'", _
"C:\FolderName", Range("A3")

This doesn't:

GetTextFileData "SELECT * FROM file name.txt WHERE fieldname = 'criteria'", _
"C:\FolderName", Range("A3")

I've tried this:

GetTextFileData "SELECT * FROM [file name.txt] WHERE fieldname = 'criteria'", _
"C:\FolderName", Range("A3")

Still no luck....Any suggestions??

Hi

Currently I need a macro to import text file into a excel file and this is the code below. However every time when the text file is import, a new excel file will be created, can anyone help me to change the code, so that the text file will always import into the same excel file name " monthly standard working file".
Code:

      Dim ResultStr As String
      Dim FileName As String
      Dim FileNum As Integer
      Dim Counter As Double
      FileName = InputBox("Enter the Text File's name, e.g. test.txt")
      If FileName = "" Then End
      FileNum = FreeFile()
      Open FileName For Input As #FileNum
      Application.ScreenUpdating = False
      Workbooks.Add template:=xlWorksheet
      Counter = 1
      Do While Seek(FileNum) <= LOF(FileNum)
          Application.StatusBar = "Importing Row " & _
             Counter & " of text file " & FileName
          Line Input #FileNum, ResultStr
          If Left(ResultStr, 1) = "=" Then
             ActiveCell.Value = "'" & ResultStr
          Else
             ActiveCell.Value = ResultStr
          End If
          If ActiveCell.Row = 65536 Then
             ActiveWorkbook.Sheets.Add
          Else
             ActiveCell.Offset(1, 0).Select
          End If
          Counter = Counter + 1
      Loop
      Close
      Application.StatusBar = False
     
      End Sub

Hi,

I have been using the following sub code below which works fine to import a folder full of text files, however it seems to import them in a strange order.
So I would also like to import the file name with each import above each set of data.

any help would be greatly welcomed


Code:

Sub ImportFiles()
Dim sh As Worksheet, sPath As String, sName As String
Dim r As Range, Fname As String
Dim ShtName1 As String
Dim ShtName As String
Dim NewSht As Worksheet
 
With Application.FileDialog(msoFileDialogFolderPicker)
 .AllowMultiSelect = False
 If .Show = 0 Then
 Exit Sub
 Else
 If .Show Then sPath = .SelectedItems(1) & "\" Else Path = Null
 End If
End With
 
Application.StatusBar = " Importing Race Results, Please wait...."
Application.ScreenUpdating = False
 '  add new sheets for processing files
 
ShtName1 = "FULL RESULTS"
On Error Resume Next
Set sh = Sheets(ShtName1)
On Error GoTo 0
If sh Is Nothing Then
Set NewSht1 = Worksheets.Add
NewSht1.name = ShtName1
End If
Set sh = ActiveSheet
ShtName = "TEMPS"
On Error Resume Next
Set NewSht = Sheets(ShtName)
On Error GoTo 0
If NewSht Is Nothing Then
Set NewSht = Worksheets.Add
NewSht.name = ShtName
End If
 
' Set path details
 sName = Dir(sPath & "*.txt")
Do While sName  ""
NewSht.Activate
Fname = sPath & sName
 
 ' Copy Data from text files and add formating
   NewSht.Cells.ClearContents
   With NewSht.QueryTables.Add( _
      Connection:="TEXT;" & Fname _
       , Destination:=NewSht.Range("$A$1"))
      .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 4
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierNone
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 9, 9, 9)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
      
  End With
 
Set r = sh.Cells(Rows.Count, 1).End(xlUp)
If r.Value  "" Then Set r = r(4)
NewSht.Range("A1").CurrentRegion.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
     Selection.Borders(xlEdgeLeft).LineStyle = xlNone
     Selection.Borders(xlEdgeTop).LineStyle = xlNone
     Selection.Borders(xlEdgeBottom).LineStyle = xlNone
     Selection.Borders(xlEdgeRight).LineStyle = xlNone
 
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
 
' copy data to final sheet 
NewSht.Range("A1").CurrentRegion.Copy
r.PasteSpecial Paste:=xlPasteAllUsingSourceTheme
sName = Dir()
Loop
' reset display after copy and pasting all data
Application.DisplayAlerts = False
 NewSht.Delete
Application.DisplayAlerts = True
sh.Columns("B:E").EntireColumn.AutoFit
sh.Columns("A:E").HorizontalAlignment = xlCenter
sh.Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
sh.Range("A1").Select
Application.ScreenUpdating = True
Application.StatusBar = ""

End Sub

I import a text file that some cells have blanks because there suppressed
repetative data.
Meaning if column a had
boy


bug

car
=======================================
I want someway to fill blanks like
boy
boy
boy
bug
bug
car

I know if I import into excel I could select data edit goto special blanks
enter = in active cell point to cell above and press CTRL + ENTER simultainiously.

The text file is too large for excel so I need that function in Access.
Thank you for your anticipated response.
Yaneckc@aol.com

Hi
below is a sample of a text file I have to import into excel the bold type number and date are usless to me I only need the time and the numbers that follow so my question is how to only import the time line not the date line?

thanks

lneilson

481620 11/27/2008
6:04 AM 07 09 12 15 22 24 26 27 33 35 36 37 38 55 57 61 68 70 73 74 1x
481621 11/27/2008
6:08 AM 01 02 04 05 07 16 18 31 40 45 47 50 59 61 62 63 71 75 76 79 1x
481622 11/27/2008
6:12 AM 06 08 10 13 17 20 22 30 33 36 38 47 49 50 55 57 61 69 70 75 2x
481623 11/27/2008
6:16 AM 04 15 21 22 26 32 33 39 42 44 50 60 62 63 64 65 66 70 71 76 2x
481624 11/27/2008
6:20 AM 01 06 07 08 14 16 17 19 26 27 32 33 40 46 48 49 56 66 76 78 1x

Hi All,

I have been using the code found at the following website to import a big text file into excel. This code creates a new worksheet and keeps importing data into the new worksheet when the previous worksheet is full (> 65536 rows).

http://www.cpearson.com/excel/importbigfiles.aspx

What I would like to do rather is stop adding a new worksheet and use the next worksheet in the workbook (i.e once sheet1 is full, use sheet2 which will be already in the workbook and will not need to be created). I believe the section of code that needs to be changed is below. Any help would be greatly appreciated

RowNdx = RowNdx + 1
If (RowNdx > Rows.Count) Or (RowNdx > LastRowForInput) Or (RowsThisSheet > MaxRowsPerSheet) Then
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' We're past the end of the worksheet or past the row
' specified in LastRowForInput or the rows used on this
' worksheet is greater than MaxRowsPerSheet.
'
' Increment the SheetNumber index and either create a
' new sheet (if C_TEMPLATE_SHEET_NAME is vbNullString) or
' copy the C_TEMPLATE_SHEET_NAME worksheet
' immediately after the current sheet, and name it
' C_SHEET_NAME_PREFIX & Format(SheetNumber, "0")
' Reset the RowNdx value to C_START_ROW_LATER_PAGE
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
SheetNumber = SheetNumber + 1
If C_TEMPLATE_SHEET_NAME = vbNullString Then
Set WS = ActiveWorkbook.Worksheets.Add(after:=WS)
Else
ActiveWorkbook.Worksheets(C_TEMPLATE_SHEET_NAME).Copy after:=WS
Set WS = ActiveWorkbook.ActiveSheet
End If
On Error Resume Next
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ignore the error that might arise if there is already a
' sheet named
' C_SHEET_NAME_PREFIX & Format(SheetNumber, "0")
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
WS.Name = C_SHEET_NAME_PREFIX & Format(SheetNumber, "0")
On Error GoTo 0

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Reset out counters.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
RowNdx = C_START_ROW_LATER_PAGES
RowsThisSheet = 0
End If