Problem w/ open no extention file
 

Hello,

I created a macro to pull in multiple text or no extention files and
paste the data into a "Raw Data" sheet in a master file. My code tell it
to use delimiter option when openning the files, but they are openning
as a fixed width instead. What's wrong w/ my code. THanks for any
support.

Here the code:
Private Sub DoTheImportForAllFiles()

Dim FName As Variant
Dim N As Long
Dim testWks As Worksheet
Dim rCtr As Long

'just some housekeeping functions
Set testWks = Nothing
On Error Resume Next
Set testWks = ThisWorkbook.Worksheets("Raw Data")
On Error GoTo 0
If testWks Is Nothing Then
ThisWorkbook.Worksheets.Add
ActiveSheet.Name = "Raw Data"
End If

If Application.CountA _
(ThisWorkbook.Worksheets("Raw Data").UsedRange) 0 Then
MsgBox "Please clean up the Raw Data Worksheet. It should be
empty!"
Exit Sub
End If

FName = Application.GetOpenFilename _
(FileFilter:="All Files (*.*),*.*", MultiSelect:=True)
Application.ScreenUpdating = False

If IsArray(FName) Then
rCtr = 1
For N = LBound(FName) To UBound(FName)
Application.StatusBar = "processing: " & FName(N)
Call DoIndividualFiles(FName(N), rCtr)
rCtr = rCtr + 1000
Next N
Else
MsgBox "No file selected"
End If

With Application
.StatusBar = False
.ScreenUpdating = True
End With

End Sub

Private Sub DoIndividualFiles(myFileName As Variant, rowCtr As Long)

Dim curWks As Worksheet
Dim destCell As Range
Dim newWks As Worksheet

Workbooks.OpenText FileName:=myFileName, _
Origin:=xlWindows, StartRow:=1, _
DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False,
Comma:=False, _
Space:=True, Other:=False, _
FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), _
Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1))

Set curWks = ActiveSheet

With ThisWorkbook.Worksheets("Raw Data")
Set destCell = .Range("A" & rowCtr)
End With

curWks.Range("a1").Resize(999, 19).Copy _
Destination:=destCell

curWks.Parent.Close savechanges:=False


End Sub


Cameron

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

Problem w/ open no extention file
 

This is a guess...

I think your files have extensions. In fact, I think the extension is .csv
(Comma separated values).

Excel will ignore your code when you open a .csv file in code.

In win98, I can make sure I can see the extension by starting windows explorer
(not internet explorer!).

Then Tools|Folder Options|View tab
Uncheck "hide file extensions for known file types"

The workaround to get your code to work is to rename your .csv files to .txt.



Cam Hua wrote:

Hello,

I created a macro to pull in multiple text or no extention files and
paste the data into a "Raw Data" sheet in a master file. My code tell it
to use delimiter option when openning the files, but they are openning
as a fixed width instead. What's wrong w/ my code. THanks for any
support.

Here the code:
Private Sub DoTheImportForAllFiles()

Dim FName As Variant
Dim N As Long
Dim testWks As Worksheet
Dim rCtr As Long

'just some housekeeping functions
Set testWks = Nothing
On Error Resume Next
Set testWks = ThisWorkbook.Worksheets("Raw Data")
On Error GoTo 0
If testWks Is Nothing Then
ThisWorkbook.Worksheets.Add
ActiveSheet.Name = "Raw Data"
End If

If Application.CountA _
(ThisWorkbook.Worksheets("Raw Data").UsedRange) 0 Then
MsgBox "Please clean up the Raw Data Worksheet. It should be
empty!"
Exit Sub
End If

FName = Application.GetOpenFilename _
(FileFilter:="All Files (*.*),*.*", MultiSelect:=True)
Application.ScreenUpdating = False

If IsArray(FName) Then
rCtr = 1
For N = LBound(FName) To UBound(FName)
Application.StatusBar = "processing: " & FName(N)
Call DoIndividualFiles(FName(N), rCtr)
rCtr = rCtr + 1000
Next N
Else
MsgBox "No file selected"
End If

With Application
.StatusBar = False
.ScreenUpdating = True
End With

End Sub

Private Sub DoIndividualFiles(myFileName As Variant, rowCtr As Long)

Dim curWks As Worksheet
Dim destCell As Range
Dim newWks As Worksheet

Workbooks.OpenText FileName:=myFileName, _
Origin:=xlWindows, StartRow:=1, _
DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False,
Comma:=False, _
Space:=True, Other:=False, _
FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), _
Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1))

Set curWks = ActiveSheet

With ThisWorkbook.Worksheets("Raw Data")
Set destCell = .Range("A" & rowCtr)
End With

curWks.Range("a1").Resize(999, 19).Copy _
Destination:=destCell

curWks.Parent.Close savechanges:=False


End Sub

Cameron

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

--

Dave Peterson

Problem w/ open no extention file
 

My guess was that the file names have extensions, but you've turned them off so
you can't see them.

Dave Peterson wrote:

This is a guess...

I think your files have extensions. In fact, I think the extension is .csv
(Comma separated values).

Excel will ignore your code when you open a .csv file in code.

In win98, I can make sure I can see the extension by starting windows explorer
(not internet explorer!).

Then Tools|Folder Options|View tab
Uncheck "hide file extensions for known file types"

The workaround to get your code to work is to rename your .csv files to .txt.

Cam Hua wrote:

Hello,

I created a macro to pull in multiple text or no extention files and
paste the data into a "Raw Data" sheet in a master file. My code tell it
to use delimiter option when openning the files, but they are openning
as a fixed width instead. What's wrong w/ my code. THanks for any
support.

Here the code:
Private Sub DoTheImportForAllFiles()

Dim FName As Variant
Dim N As Long
Dim testWks As Worksheet
Dim rCtr As Long

'just some housekeeping functions
Set testWks = Nothing
On Error Resume Next
Set testWks = ThisWorkbook.Worksheets("Raw Data")
On Error GoTo 0
If testWks Is Nothing Then
ThisWorkbook.Worksheets.Add
ActiveSheet.Name = "Raw Data"
End If

If Application.CountA _
(ThisWorkbook.Worksheets("Raw Data").UsedRange) 0 Then
MsgBox "Please clean up the Raw Data Worksheet. It should be
empty!"
Exit Sub
End If

FName = Application.GetOpenFilename _
(FileFilter:="All Files (*.*),*.*", MultiSelect:=True)
Application.ScreenUpdating = False

If IsArray(FName) Then
rCtr = 1
For N = LBound(FName) To UBound(FName)
Application.StatusBar = "processing: " & FName(N)
Call DoIndividualFiles(FName(N), rCtr)
rCtr = rCtr + 1000
Next N
Else
MsgBox "No file selected"
End If

With Application
.StatusBar = False
.ScreenUpdating = True
End With

End Sub

Private Sub DoIndividualFiles(myFileName As Variant, rowCtr As Long)

Dim curWks As Worksheet
Dim destCell As Range
Dim newWks As Worksheet

Workbooks.OpenText FileName:=myFileName, _
Origin:=xlWindows, StartRow:=1, _
DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False,
Comma:=False, _
Space:=True, Other:=False, _
FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), _
Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1))

Set curWks = ActiveSheet

With ThisWorkbook.Worksheets("Raw Data")
Set destCell = .Range("A" & rowCtr)
End With

curWks.Range("a1").Resize(999, 19).Copy _
Destination:=destCell

curWks.Parent.Close savechanges:=False


End Sub

Cameron

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

--

Dave Peterson


--

Dave Peterson