"Soft Code" Find File Directory Or Alternative

[Neon520]

Hi everyone,

I was told about how to "Hard Code" a File Directory to Open All files in
one particular folder.

My concern is what if the users Rename the folder or Move the folder to a
different location, then "Hard Code" won't work properly.

2 Method I could think of:

1. How to "Soft Code" it so that user can "BROWSE" the folder location once
it's been MOVED or REMOVED. (Something similar to Mail Merge Feature in MS
Word, there is an "option" for user to Browse to folder location Or and
"Exit" to quit the operation)

2. Is there a way to prevent the user to move or rename the folder, frankly
LOCK the folder? (I know this is somewhat outside the scope of this forum,
but I'm going to ask it anyway)

FYI, I'm using Office 2004 for Mac.
Neon520

 

[Gary''s Student]

A really simple was is to use the getopenfile dialogbox to allow the user to
pick a file in the desired folder.

The macro can then just keep the path (folder name) and discard the filename:

Sub findAfolder()
s = Application.GetOpenFilename()
ar = Split(s, "\")
ar(UBound(ar)) = ""
v = Join(ar, "\")
MsgBox (v)
End Sub

 

[Neon520]

Hi gsnu200821 (aka Gary's Student),

I'm not sure if your code do what I'd like it to do, but here is what I got,
and All I need is to let the user browse the folder directory to find the
right folder IF and ONLY IF the folder has been moved or renamed.

' Transfer Macro
'
' Keyboard Shortcut: Option+Cmd+x
'

Mymonth = InputBox("Enter Name of Month (ALL CAPS): ")

Set NewSht = ThisWorkbook.ActiveSheet

Folder = "Users:Neonesktop:TEST FOLDER:"
FName = Dir(Folder, MacID("XLS8"))

'MsgBox ("Found file:" & FName)
Newrowcount = 2
Do While FName <> ""
Set OldBk = Workbooks.Open(Filename:=Folder & FName)
For Each Sht In OldBk.Sheets
'MsgBox ("check Sheet : " & Sht.Name)
With Sht
Oldrowcount = 7
Do While .Range("B" & Oldrowcount) <> ""
If UCase(.Range("B" & Oldrowcount)) = Mymonth Then
'Range("B7:B38").Copy
'Range("D1").PasteSpecial Paste:=xlPasteValues
..Rows(Oldrowcount).Copy _
Destination:=NewSht.Rows(Newrowcount)
'NewSht.Range("A" & Newrowcount) = .Range("A" & Oldrowcount)
'NewSht.Range("B" & Newrowcount) = .Range("B" & Oldrowcount)
'NewSht.Range("C" & Newrowcount) = .Range("C" & Oldrowcount)
'NewSht.Range("D" & Newrowcount) = .Range("D" & Oldrowcount)
Newrowcount = Newrowcount + 1
End If
Oldrowcount = Oldrowcount + 1
Loop
End With
Next Sht
OldBk.Close savechanges:=False
FName = Dir()
'MsgBox ("Found file : " & FName)
Loop

End Sub

FYI, I'm using Office 2004 for Mac.

Thank you,
Neon520