Here is what I am trying....as always, TIA, please be gentle, self taught from all of the experts who answer Google, Mr. Excel and have sites on the web. 
I can get the import macro to run as a macro, and I can get the file location module to work alone, can't get them to work together. I am in the Army, and working with lots of text files. It is difficult to get the user to place the file in the same place, so that is what I am trying to over come. My macro does what I want it to, though I am sure the code can be cleaned up (like telling the CONCATENATE statement to not use the blank cells) some.
Thanks all who looked but were not able to help due to the lack of code.
Ron
Option Explicit
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Public Sub ImportTextFile(FileName As String)
Dim txtFile As String
Dim VPath As String
'VPath = ActiveWorkbook.path + "\"
Dim FName As String
Dim RowNdx As Integer
Dim ColNdx As Integer
Dim TempVal As Variant
Dim WholeLine As String
Dim pos As Integer
Dim NextPos As Integer
Dim SaveColNdx As Integer
Dim Message As String
Dim Default As String
Dim Title As String
Dim Msg As String
Dim Sep As String
Dim NumRecords As Integer
' ** Get the input data file name from the user (Master.txt normally)
Message = "Enter File name to import"
Title = "1A JOPES Data Utility"
Default = FileName
FName = InputBox(Message, Title, Default)
'If user enters nothing, then bring them back to idle at instruction page.
If FName = "" Then End
' ** Get directory where the file is
Msg = "Please select the folder where the file: " + FName + " resides."
VPath = GetDirectory(Msg) + "\"
'If user enters nothing, then bring them back to idle at instruction page.
If VPath = "" Then End
'Clear out the old data
Select Case FileName
Case "Master"
Sheets("Master").Select
'Clear old data
Columns("A:AZ").Select
Selection.ClearContents
Cells(1, 1).Select
Case Else
End
End Select
'Display dialog box to get the filename to open
txtFile = Application.GetOpenFilename("Text Files (*.txt), *.txt", , "Import " + FileName)
Application.DisplayStatusBar = True
Application.StatusBar = "Importing File...."
'Application.ScreenUpdating = False
On Error GoTo EndMacro:
SaveColNdx = ActiveCell.Column
RowNdx = ActiveCell.row
Origin:=xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(7, 9), Array ( 8, 1), Array(14, 9), Array(15, 1), Array(30, 9), Array(31, 1), Array(48, 9), Array(49, 5), _
Array(59, 9), Array(60, 1), Array(61, 9), Array(62, 1), Array(64, 9), Array(65, 1), Array( _
68, 9), Array(69, 5), Array(79, 9), Array(80, 5), Array(90, 9), Array(91, 1), Array(95, 9), _
Array(96, 1), Array(100, 9), Array(101, 1), Array(107, 9), Array(108, 1), Array(114, 9), _
Array(115, 1), Array(118, 9), Array(119, 1), Array(136, 9), Array(137, 1), Array(141, 9), _
Array(142, 1), Array(147, 9), Array(148, 1), Array(155, 9), Array(156, 1), Array(171, 9), _
Array(172, 1), Array(182, 9), Array(183, 1), Array(187, 9), Array(188, 1), Array(198, 9), _
Array(199, 1), Array(203, 9), Array(204, 1), Array(214, 9), Array(215, 1), Array(219, 9), _
Array(220, 1), Array(230, 9), Array(231, 1), Array(235, 9), Array(236, 1), Array(251, 9), _
Array(252, 1), Array(259, 9), Array(260, 1), Array(269, 9), Array(270, 1), Array(275, 9), _
Array(276, 1), Array(293, 9), Array(294, 1), Array(298, 9), Array(299, 1), Array(316, 9), _
Array(317, 1), Array(322, 9), Array(323, 1), Array(353, 9), Array(354, 1), Array(385, 9), _
Array(386, 1)), TrailingMinusNumbers:=True _
Range("A1").Select
Selection.EntireRow.Insert
Selection.EntireRow.Insert
Range("A2").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(R[1]C,"" "",R[2]C)"
Selection.AutoFill Destination:=Range("A2:AH2"), Type:=xlFillDefault
Range("A2:AH2").Select
Selection.End(xlToLeft).Select
Rows("2:2").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Paste
Selection.Columns.AutoFit
'NumRecords = 0
'While Not EOF(1)
' Line Input #1, WholeLine
' NumRecords = NumRecords + 1 'increment the record counter
'
' If Right(WholeLine, 1) <> Sep Then
' WholeLine = WholeLine & Sep
' End If
' ColNdx = SaveColNdx
' pos = 1
' NextPos = InStr(pos, WholeLine, Sep)
' While NextPos >= 1
' TempVal = Mid(WholeLine, pos, NextPos - pos)
' Cells(RowNdx, ColNdx).Value = TempVal
' pos = NextPos + 1
' ColNdx = ColNdx + 1
' NextPos = InStr(pos, WholeLine, Sep)
' Wend
' RowNdx = RowNdx + 1
'Wend
EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Application.StatusBar = False
Cells(1, 1).Select
TempVal = MsgBox("Import of " + FName + " file Completed.", vbOKOnly, "JOPES Master Import Utility")
'End of data input routine
End Sub
Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
' Root folder = Desktop
bInfo.pidlRoot = 0&
' Title in the dialog
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder."
Else
bInfo.lpszTitle = Msg
End If
' Type of directory to return
bInfo.ulFlags = &H1
' Display the dialog
x = SHBrowseForFolder(bInfo)
' Parse the result
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Else
GetDirectory = ""
End If
End Function[/quote]
I can get the import macro to run as a macro, and I can get the file location module to work alone, can't get them to work together. I am in the Army, and working with lots of text files. It is difficult to get the user to place the file in the same place, so that is what I am trying to over come. My macro does what I want it to, though I am sure the code can be cleaned up (like telling the CONCATENATE statement to not use the blank cells) some.Thanks all who looked but were not able to help due to the lack of code.
Ron
Option Explicit
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Public Sub ImportTextFile(FileName As String)
Dim txtFile As String
Dim VPath As String
'VPath = ActiveWorkbook.path + "\"
Dim FName As String
Dim RowNdx As Integer
Dim ColNdx As Integer
Dim TempVal As Variant
Dim WholeLine As String
Dim pos As Integer
Dim NextPos As Integer
Dim SaveColNdx As Integer
Dim Message As String
Dim Default As String
Dim Title As String
Dim Msg As String
Dim Sep As String
Dim NumRecords As Integer
' ** Get the input data file name from the user (Master.txt normally)
Message = "Enter File name to import"
Title = "1A JOPES Data Utility"
Default = FileName
FName = InputBox(Message, Title, Default)
'If user enters nothing, then bring them back to idle at instruction page.
If FName = "" Then End
' ** Get directory where the file is
Msg = "Please select the folder where the file: " + FName + " resides."
VPath = GetDirectory(Msg) + "\"
'If user enters nothing, then bring them back to idle at instruction page.
If VPath = "" Then End
'Clear out the old data
Select Case FileName
Case "Master"
Sheets("Master").Select
'Clear old data
Columns("A:AZ").Select
Selection.ClearContents
Cells(1, 1).Select
Case Else
End
End Select
'Display dialog box to get the filename to open
txtFile = Application.GetOpenFilename("Text Files (*.txt), *.txt", , "Import " + FileName)
Application.DisplayStatusBar = True
Application.StatusBar = "Importing File...."
'Application.ScreenUpdating = False
On Error GoTo EndMacro:
SaveColNdx = ActiveCell.Column
RowNdx = ActiveCell.row
Origin:=xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(7, 9), Array ( 8, 1), Array(14, 9), Array(15, 1), Array(30, 9), Array(31, 1), Array(48, 9), Array(49, 5), _
Array(59, 9), Array(60, 1), Array(61, 9), Array(62, 1), Array(64, 9), Array(65, 1), Array( _
68, 9), Array(69, 5), Array(79, 9), Array(80, 5), Array(90, 9), Array(91, 1), Array(95, 9), _
Array(96, 1), Array(100, 9), Array(101, 1), Array(107, 9), Array(108, 1), Array(114, 9), _
Array(115, 1), Array(118, 9), Array(119, 1), Array(136, 9), Array(137, 1), Array(141, 9), _
Array(142, 1), Array(147, 9), Array(148, 1), Array(155, 9), Array(156, 1), Array(171, 9), _
Array(172, 1), Array(182, 9), Array(183, 1), Array(187, 9), Array(188, 1), Array(198, 9), _
Array(199, 1), Array(203, 9), Array(204, 1), Array(214, 9), Array(215, 1), Array(219, 9), _
Array(220, 1), Array(230, 9), Array(231, 1), Array(235, 9), Array(236, 1), Array(251, 9), _
Array(252, 1), Array(259, 9), Array(260, 1), Array(269, 9), Array(270, 1), Array(275, 9), _
Array(276, 1), Array(293, 9), Array(294, 1), Array(298, 9), Array(299, 1), Array(316, 9), _
Array(317, 1), Array(322, 9), Array(323, 1), Array(353, 9), Array(354, 1), Array(385, 9), _
Array(386, 1)), TrailingMinusNumbers:=True _
Range("A1").Select
Selection.EntireRow.Insert
Selection.EntireRow.Insert
Range("A2").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(R[1]C,"" "",R[2]C)"
Selection.AutoFill Destination:=Range("A2:AH2"), Type:=xlFillDefault
Range("A2:AH2").Select
Selection.End(xlToLeft).Select
Rows("2:2").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Paste
Selection.Columns.AutoFit
'NumRecords = 0
'While Not EOF(1)
' Line Input #1, WholeLine
' NumRecords = NumRecords + 1 'increment the record counter
'
' If Right(WholeLine, 1) <> Sep Then
' WholeLine = WholeLine & Sep
' End If
' ColNdx = SaveColNdx
' pos = 1
' NextPos = InStr(pos, WholeLine, Sep)
' While NextPos >= 1
' TempVal = Mid(WholeLine, pos, NextPos - pos)
' Cells(RowNdx, ColNdx).Value = TempVal
' pos = NextPos + 1
' ColNdx = ColNdx + 1
' NextPos = InStr(pos, WholeLine, Sep)
' Wend
' RowNdx = RowNdx + 1
'Wend
EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Application.StatusBar = False
Cells(1, 1).Select
TempVal = MsgBox("Import of " + FName + " file Completed.", vbOKOnly, "JOPES Master Import Utility")
'End of data input routine
End Sub
Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
' Root folder = Desktop
bInfo.pidlRoot = 0&
' Title in the dialog
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder."
Else
bInfo.lpszTitle = Msg
End If
' Type of directory to return
bInfo.ulFlags = &H1
' Display the dialog
x = SHBrowseForFolder(bInfo)
' Parse the result
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Else
GetDirectory = ""
End If
End Function[/quote]
