Take a look at Application.getopenfilename() in VBA's help.
Here's how I do it when I want a toolbar:
http://groups.google.co.uk/groups?th...5B41%40msn.com
====
Heck, try putting this into a general module:
Option Explicit
Public Const ToolBarName As String = "ImportGrantTB"
Sub auto_open()
Call create_menubar
End Sub
Sub auto_close()
Call remove_menubar
End Sub
Sub remove_menubar()
On Error Resume Next
Application.CommandBars(ToolBarName).Delete
On Error GoTo 0
End Sub
Sub create_menubar()
Dim i As Long
Dim mac_names As Variant
Dim cap_names As Variant
Dim tip_text As Variant
Call remove_menubar
mac_names = Array("ImportGrant")
cap_names = Array("Import Grant Text File")
tip_text = Array("Click this to import the text file")
With Application.CommandBars.Add
.Name = ToolBarName
.Left = 200
.Top = 200
.Protection = msoBarNoProtection
.Visible = True
.Position = msoBarFloating
For i = LBound(mac_names) To UBound(mac_names)
With .Controls.Add(Type:=msoControlButton)
.OnAction = ThisWorkbook.Name & "!" & mac_names(i)
.Caption = cap_names(i)
.Style = msoButtonIconAndCaption
.FaceId = 71 + i
.TooltipText = tip_text(i)
End With
Next i
End With
End Sub
Sub ImportGrant()
Dim myFileName As Variant
Dim wks As Worksheet
myFileName = Application.GetOpenFilename("Text Files, *.txt")
If myFileName = False Then
Exit Sub
End If
Workbooks.OpenText Filename:=myFileName, _
Origin:=437, StartRow:=1, DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 2), Array(3, 2), Array(43, 2), _
Array(45, 2), Array(55, 3), Array(64, 3), _
Array(73, 2), Array(84, 2), Array(91, 2), Array(98, 2))
Set wks = ActiveSheet
With wks
.Rows(1).Insert
.Range("a1").Resize(1, 10).Value _
= Array("State", "Client", "Address", "Phone#", "Start", _
"End", "PO", "Code", "GS", "Description")
.Columns.AutoFit
Application.DisplayAlerts = False
On Error Resume Next
.Parent.SaveAs Filename:="C:\AQ\Excel Add-In\Grant111405SFD.xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
If Err.Number < 0 Then
MsgBox "An error occurred--workbook was not saved!"
Err.Clear
End If
On Error GoTo 0
Application.DisplayAlerts = True
End With
End Sub
A.Q wrote:
Hi all,
I'm new to excel programming, and need help.
I have this recorded macro and want to do 2 things with it now.
1st: I need to code so that I can let the user to select they own
directories and file in text format, then open it in excel.
2nd: I need to save this macro as an add-in format with toolbar?
Sub ImportGrant()
'
' ImportGrant Macro
' Macro recorded 12/22/2005 by aquach
'
'
ChDir "C:\AQUACH\Excel Add-In"
Workbooks.OpenText Filename:="C:\AQ\Excel Add-In\GrantTest.txt", Origin _
:=437, StartRow:=1, DataType:=xlFixedWidth,
FieldInfo:=Array(Array(0, 2), _
Array(3, 2), Array(43, 2), Array(45, 2), Array(55, 3), Array(64, 3),
Array(73, 2), Array(84 _
, 2), Array(91, 2), Array(98, 2)), TrailingMinusNumbers:=True
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Range("A1").Select
ActiveCell.FormulaR1C1 = "State"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Client"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Address"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Phone#"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Start"
Range("F1").Select
ActiveCell.FormulaR1C1 = "End"
Range("G1").Select
ActiveCell.FormulaR1C1 = "PO"
Range("H1").Select
ActiveCell.FormulaR1C1 = "Code"
Range("I1").Select
ActiveCell.FormulaR1C1 = "GS"
Range("J1").Select
ActiveCell.FormulaR1C1 = "Description"
Range("K1").Select
ActiveWorkbook.SaveAs Filename:="C:\AQ\Excel Add-In\Grant111405SFD.xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End Sub
--
Dave Peterson