I am trying to make an excel macro that can browse for a file to get the
path to the file for copy purposes. I have figured out how to do this on
a PC with this code:Code:
--------------------
Option Explicit
Type thOPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
strFilter As String
strCustomFilter As String
nMaxCustFilter As String
nFilterIndex As Long
strFile As String
nMaxFile As Long
strFileTitle As String
nMaxFileTitle As Long
strInitialDir As String
strTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
strDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Declare Function th_apiGetOpenFileName Lib quot;comdlg32.dllquot; Alias quot;GetOpenFileNameAquot; (OFN As thOPENFILENAME) As Boolean
Declare Function th_apiGetSaveFileName Lib quot;comdlg32.dllquot; Alias quot;GetSaveFileNameAquot; (OFN As thOPENFILENAME) As Boolean
Declare Function CommDlgExtendetError Lib quot;commdlg32.dllquot; () As Long
Private Const thOFN_READONLY = amp;H1
Private Const thOFN_OVERWRITEPROMPT = amp;H2
Private Const thOFN_HIDEREADONLY = amp;H4
Private Const thOFN_NOCHANGEDIR = amp;H8
Private Const thOFN_SHOWHELP = amp;H10
Private Const thOFN_NOVALIDATE = amp;H100
Private Const thOFN_ALLOWMULTISELECT = amp;H200
Private Const thOFN_EXTENSIONDIFFERENT = amp;H400
Private Const thOFN_PATHMUSTEXIST = amp;H800
Private Const thOFN_FILEMUSTEXIST = amp;H1000
Private Const thOFN_CREATEPROMPT = amp;H2000
Private Const thOFN_SHAREWARE = amp;H4000
Private Const thOFN_NOREADONLYRETURN = amp;H8000
Private Const thOFN_NOTESTFILECREATE = amp;H10000
Private Const thOFN_NONETWORKBUTTON = amp;H20000
Private Const thOFN_NOLONGGAMES = amp;H40000
Private Const thOFN_EXPLORER = amp;H80000
Private Const thOFN_NODEREFERENCELINKS = amp;H100000
Private Const thOFN_LONGNAMES = amp;H200000
Sub AddRosterFromFile()
Dim strFilter As String
Dim lngFlags As Long
Dim FileName As String
strFilter = thAddFilterItem(strFilter, quot;Excel Files (*.xls)quot;, quot;*.XLSquot;)
strFilter = thAddFilterItem(strFilter, quot;All Files (*.*)quot;, quot;*.*quot;)
FileName = thCommonFileOpenSave(InitialDir:=CurDir(), Filter:=strFilter, FilterIndex:=2, Flags:=lngFlags, DialogTitle:=quot;File Browserquot;)
If FileName lt;gt; quot;quot; Then
Dim first, last As Integer
Workbooks.Open FileName:=FileName
Debug.Print Hex(lngFlags)
Sheets(quot;Sheet3quot;).Select
Cells.Select
Selection.Sort Key1:=Range(quot;A2quot;), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range(quot;A2quot;).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows(quot;Gradebook.xlsquot;).Activate
first = ActiveSheet.Range(quot;A65536quot;).End(xlUp).Row 1
Range(quot;Aquot; amp; first).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
last = ActiveSheet.Range(quot;A65536quot;).End(xlUp).Row 1
Windows(Mid(FileName, Len(CurDir()) 2, Len(FileName) - Len(CurDir()))).Activate
ActiveWindow.Close
Windows(quot;Gradebook.xlsquot;).Activate
'Enter sort formulas
Range(quot;Equot; amp; first, quot;Equot; amp; last).Select
Selection.FormulaR1C1 = quot;=MID(RC[-2],1,LEN(RC[-2])-5)quot;End If
End Sub
Function GetOpenFile(Optional varDirectory As Variant, Optional varTitleForDialog As Variant) As Variant
Dim strFilter As String
Dim lngFlags As Long
Dim varFileName As Variant
lngFlags = thOFN_FILEMUSTEXIST Or thOFN_HIDEREADONLY Or thOFN_NOCHANGEDIR
If IsMissing(varDirectory) Then varDirectory = quot;quot;
End If
If IsMissing(varTitleForDialog) Then varTitleForDialog = quot;quot;
End If
strFilter = thAddFilterItem(strFilter, quot;Excel (*.xls)quot;, quot;*.XLSquot;)
varFileName = thCommonFileOpenSave(OpenFile:=True, InitialDir:=varDirectory, Filter:=strFilter, Flags:=lngFlags, DialogTitle:=varTitleForDialog)
If Not IsNull(varFileName) Then varFileName = TrimNull(varFileName)
End If
GetOpenFile = varFileName
End Function
Function thCommonFileOpenSave(Optional ByRef Flags As Variant, Optional ByVal InitialDir As Variant, Optional ByVal Filter As Variant, _
Optional ByVal FilterIndex As Variant, Optional ByVal DefaultEx As Variant, Optional ByVal FileName As Variant, _
Optional ByVal DialogTitle As Variant, Optional ByVal hwnd As Variant, Optional ByVal OpenFile As Variant) As Variant
Dim OFN As thOPENFILENAME
Dim strFileName As String
Dim FileTitle As String
Dim fResult As Boolean
If IsMissing(InitialDir) Then InitialDir = CurDir
If IsMissing(Filter) Then Filter = quot;quot;
If IsMissing(FilterIndex) Then FilterIndex = 1
If IsMissing(Flags) Then Flags = 0amp;
If IsMissing(DefaultEx) Then DefaultEx = quot;quot;
If IsMissing(FileName) Then FileName = quot;quot;
If IsMissing(DialogTitle) Then DialogTitle = quot;quot;
If IsMissing(hwnd) Then hwnd = 0
If IsMissing(OpenFile) Then OpenFile = True
strFileName = Left(FileName amp; String(256, 0), 256)
FileTitle = String(256, 0)
With OFN
.lStructSize = Len(OFN)
.hwndOwner = hwnd
.strFilter = Filter
.nFilterIndex = FilterIndex
.strFile = strFileName
.nMaxFile = Len(strFileName)
.strFileTitle = FileTitle
.nMaxFileTitle = Len(FileTitle)
.strTitle = DialogTitle
.Flags = Flags
.strDefExt = DefaultEx
.strInitialDir = InitialDir
.hInstance = 0
.lpfnHook = 0
.strCustomFilter = String(255, 0)
.nMaxCustFilter = 255
End With
If OpenFile Then
fResult = th_apiGetOpenFileName(OFN)
Else
fResult = th_apiGetSaveFileName(OFN)
End If
If fResult Then
If Not IsMissing(Flags) Then Flags = OFN.Flags
thCommonFileOpenSave = TrimNull(OFN.strFile)
Else
thCommonFileOpenSave = vbNullString
End If
End Function
Function thAddFilterItem(strFilter As String, strDescription As String, Optional varItem As Variant) As String
If IsMissing(varItem) Then varItem = quot;*.*quot;
thAddFilterItem = strFilter amp; strDescription amp; vbNullChar amp; varItem amp; vbNullChar
End Function
Private Function TrimNull(ByVal strItem As String) As String
Dim intPos As Integer
intPos = InStr(strItem, vbNullChar)
If intPos gt; 0 Then
TrimNull = Left(strItem, intPos - 1)
Else
TrimNull = strItem
End If
End Function
--------------------
Anyone know how to do this on a mac, and also how to set it up so it
automaticly uses the correct one from which operating system is
curently running?
John Vickers--
John Vickers
------------------------------------------------------------------------
John Vickers's Profile: www.excelforum.com/member.php...oamp;userid=31551
View this thread: www.excelforum.com/showthread...hreadid=513751If you don't get an answer in this newsgroup, maybe you'll get one he
news://msnews.microsoft.com/microsof...c.office.excel
John Vickers wrote:
gt;
gt; I am trying to make an excel macro that can browse for a file to get the
gt; path to the file for copy purposes. I have figured out how to do this on
gt; a PC with this code:
gt;
gt; Code:
gt; --------------------
gt; Option Explicit
gt;
gt; Type thOPENFILENAME
gt; lStructSize As Long
gt; hwndOwner As Long
gt; hInstance As Long
gt; strFilter As String
gt; strCustomFilter As String
gt; nMaxCustFilter As String
gt; nFilterIndex As Long
gt; strFile As String
gt; nMaxFile As Long
gt; strFileTitle As String
gt; nMaxFileTitle As Long
gt; strInitialDir As String
gt; strTitle As String
gt; Flags As Long
gt; nFileOffset As Integer
gt; nFileExtension As Integer
gt; strDefExt As String
gt; lCustData As Long
gt; lpfnHook As Long
gt; lpTemplateName As String
gt; End Type
gt;
gt; Declare Function th_apiGetOpenFileName Lib quot;comdlg32.dllquot; Alias quot;GetOpenFileNameAquot; (OFN As thOPENFILENAME) As Boolean
gt; Declare Function th_apiGetSaveFileName Lib quot;comdlg32.dllquot; Alias quot;GetSaveFileNameAquot; (OFN As thOPENFILENAME) As Boolean
gt; Declare Function CommDlgExtendetError Lib quot;commdlg32.dllquot; () As Long
gt;
gt; Private Const thOFN_READONLY = amp;H1
gt; Private Const thOFN_OVERWRITEPROMPT = amp;H2
gt; Private Const thOFN_HIDEREADONLY = amp;H4
gt; Private Const thOFN_NOCHANGEDIR = amp;H8
gt; Private Const thOFN_SHOWHELP = amp;H10
gt; Private Const thOFN_NOVALIDATE = amp;H100
gt; Private Const thOFN_ALLOWMULTISELECT = amp;H200
gt; Private Const thOFN_EXTENSIONDIFFERENT = amp;H400
gt; Private Const thOFN_PATHMUSTEXIST = amp;H800
gt; Private Const thOFN_FILEMUSTEXIST = amp;H1000
gt; Private Const thOFN_CREATEPROMPT = amp;H2000
gt; Private Const thOFN_SHAREWARE = amp;H4000
gt; Private Const thOFN_NOREADONLYRETURN = amp;H8000
gt; Private Const thOFN_NOTESTFILECREATE = amp;H10000
gt; Private Const thOFN_NONETWORKBUTTON = amp;H20000
gt; Private Const thOFN_NOLONGGAMES = amp;H40000
gt; Private Const thOFN_EXPLORER = amp;H80000
gt; Private Const thOFN_NODEREFERENCELINKS = amp;H100000
gt; Private Const thOFN_LONGNAMES = amp;H200000
gt;
gt; Sub AddRosterFromFile()
gt; Dim strFilter As String
gt; Dim lngFlags As Long
gt; Dim FileName As String
gt; strFilter = thAddFilterItem(strFilter, quot;Excel Files (*.xls)quot;, quot;*.XLSquot;)
gt; strFilter = thAddFilterItem(strFilter, quot;All Files (*.*)quot;, quot;*.*quot;)
gt; FileName = thCommonFileOpenSave(InitialDir:=CurDir(), Filter:=strFilter, FilterIndex:=2, Flags:=lngFlags, DialogTitle:=quot;File Browserquot;)
gt; If FileName lt;gt; quot;quot; Then
gt;
gt; Dim first, last As Integer
gt;
gt; Workbooks.Open FileName:=FileName
gt; Debug.Print Hex(lngFlags)
gt;
gt; Sheets(quot;Sheet3quot;).Select
gt; Cells.Select
gt; Selection.Sort Key1:=Range(quot;A2quot;), Order1:=xlAscending, Header:=xlGuess, _
gt; OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
gt; Range(quot;A2quot;).Select
gt; Range(Selection, Selection.End(xlToRight)).Select
gt; Range(Selection, Selection.End(xlDown)).Select
gt; Selection.Copy
gt; Windows(quot;Gradebook.xlsquot;).Activate
gt; first = ActiveSheet.Range(quot;A65536quot;).End(xlUp).Row 1
gt; Range(quot;Aquot; amp; first).Select
gt; Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
gt; :=False, Transpose:=False
gt; last = ActiveSheet.Range(quot;A65536quot;).End(xlUp).Row 1
gt; Windows(Mid(FileName, Len(CurDir()) 2, Len(FileName) - Len(CurDir()))).Activate
gt; ActiveWindow.Close
gt; Windows(quot;Gradebook.xlsquot;).Activate
gt;
gt; 'Enter sort formulas
gt; Range(quot;Equot; amp; first, quot;Equot; amp; last).Select
gt; Selection.FormulaR1C1 = quot;=MID(RC[-2],1,LEN(RC[-2])-5)quot;
gt;
gt;
gt; End If
gt;
gt; End Sub
gt;
gt; Function GetOpenFile(Optional varDirectory As Variant, Optional varTitleForDialog As Variant) As Variant
gt; Dim strFilter As String
gt; Dim lngFlags As Long
gt; Dim varFileName As Variant
gt; lngFlags = thOFN_FILEMUSTEXIST Or thOFN_HIDEREADONLY Or thOFN_NOCHANGEDIR
gt;
gt; If IsMissing(varDirectory) Then varDirectory = quot;quot;
gt; End If
gt;
gt; If IsMissing(varTitleForDialog) Then varTitleForDialog = quot;quot;
gt; End If
gt;
gt; strFilter = thAddFilterItem(strFilter, quot;Excel (*.xls)quot;, quot;*.XLSquot;)
gt; varFileName = thCommonFileOpenSave(OpenFile:=True, InitialDir:=varDirectory, Filter:=strFilter, Flags:=lngFlags, DialogTitle:=varTitleForDialog)
gt;
gt; If Not IsNull(varFileName) Then varFileName = TrimNull(varFileName)
gt; End If
gt;
gt; GetOpenFile = varFileName
gt;
gt; End Function
gt;
gt; Function thCommonFileOpenSave(Optional ByRef Flags As Variant, Optional ByVal InitialDir As Variant, Optional ByVal Filter As Variant, _
gt; Optional ByVal FilterIndex As Variant, Optional ByVal DefaultEx As Variant, Optional ByVal FileName As Variant, _
gt; Optional ByVal DialogTitle As Variant, Optional ByVal hwnd As Variant, Optional ByVal OpenFile As Variant) As Variant
gt;
gt; Dim OFN As thOPENFILENAME
gt; Dim strFileName As String
gt; Dim FileTitle As String
gt; Dim fResult As Boolean
gt;
gt; If IsMissing(InitialDir) Then InitialDir = CurDir
gt; If IsMissing(Filter) Then Filter = quot;quot;
gt; If IsMissing(FilterIndex) Then FilterIndex = 1
gt; If IsMissing(Flags) Then Flags = 0amp;
gt; If IsMissing(DefaultEx) Then DefaultEx = quot;quot;
gt; If IsMissing(FileName) Then FileName = quot;quot;
gt; If IsMissing(DialogTitle) Then DialogTitle = quot;quot;
gt; If IsMissing(hwnd) Then hwnd = 0
gt; If IsMissing(OpenFile) Then OpenFile = True
gt;
gt; strFileName = Left(FileName amp; String(256, 0), 256)
gt; FileTitle = String(256, 0)
gt;
gt; With OFN
gt; .lStructSize = Len(OFN)
gt; .hwndOwner = hwnd
gt; .strFilter = Filter
gt; .nFilterIndex = FilterIndex
gt; .strFile = strFileName
gt; .nMaxFile = Len(strFileName)
gt; .strFileTitle = FileTitle
gt; .nMaxFileTitle = Len(FileTitle)
gt; .strTitle = DialogTitle
gt; .Flags = Flags
gt; .strDefExt = DefaultEx
gt; .strInitialDir = InitialDir
gt; .hInstance = 0
gt; .lpfnHook = 0
gt; .strCustomFilter = String(255, 0)
gt; .nMaxCustFilter = 255
gt; End With
gt;
gt; If OpenFile Then
gt; fResult = th_apiGetOpenFileName(OFN)
gt; Else
gt; fResult = th_apiGetSaveFileName(OFN)
gt; End If
gt;
gt; If fResult Then
gt; If Not IsMissing(Flags) Then Flags = OFN.Flags
gt; thCommonFileOpenSave = TrimNull(OFN.strFile)
gt; Else
gt; thCommonFileOpenSave = vbNullString
gt; End If
gt;
gt; End Function
gt;
gt; Function thAddFilterItem(strFilter As String, strDescription As String, Optional varItem As Variant) As String
gt;
gt; If IsMissing(varItem) Then varItem = quot;*.*quot;
gt; thAddFilterItem = strFilter amp; strDescription amp; vbNullChar amp; varItem amp; vbNullChar
gt;
gt; End Function
gt;
gt; Private Function TrimNull(ByVal strItem As String) As String
gt; Dim intPos As Integer
gt; intPos = InStr(strItem, vbNullChar)
gt; If intPos gt; 0 Then
gt; TrimNull = Left(strItem, intPos - 1)
gt; Else
gt; TrimNull = strItem
gt; End If
gt;
gt; End Function
gt; --------------------
gt;
gt; Anyone know how to do this on a mac, and also how to set it up so it
gt; automaticly uses the correct one from which operating system is
gt; curently running?
gt;
gt; John Vickers
gt;
gt; --
gt; John Vickers
gt; ------------------------------------------------------------------------
gt; John Vickers's Profile: www.excelforum.com/member.php...oamp;userid=31551
gt; View this thread: www.excelforum.com/showthread...hreadid=513751
--
Dave Peterson
- Jun 04 Wed 2008 20:44
Browse File for Mac
close
全站熱搜
留言列表
發表留言
留言列表

