PDA

View Full Version : How to get VBA to read a directory from a cell.



pablo4429
10-25-2010, 04:10 PM
Hey all,
So I have a subroutine that prompts the user to find a directory containing files they wish to analyze, the directory is then written to a cell in a sheet. What I need is a way to get either the program that I have written that needs that directory to recognize the directory the user has chosen or for the program I have written to recognize the cell where the directory is placed and use that in the open statement. The *** is where the user chooses the directory, $$$ is where the cell is read and defined in the code and %%% is where the directory needs to go.
Thanks a ton,
Paul


Dim msg As String
***MsgBox GetDirectory("Choose directory")

Dim direct As String
$$$direct = Range("i1")

'Ask user to continue with calc
Dim would As VbMsgBoxResult
would = MsgBox("Verify that file names are in format dil_##_###_##_###. First ## is dilution value in SLM, ### is coflow in SCCM, second ## is acetylene in SCCM and second ###is file number", vbQuestion + vbYesNo)
If would = vbYes Then


Dim textline2a As String
Dim spath As String
Dim file As String

k = 0
linenum = 0

'spath = "direct"
ChDir direct
file = Dir("*.dps")

Do While file <> ""

'Open "C:\Documents and Settings\SchroP96\Desktop\DPS Data (Summer and Fall2010)\10-06-2010\continuously2\" & file For Input As #1
%%%Open "direct\" & file For Input As #1

Blade Hunter
10-25-2010, 05:58 PM
Put ALL this at the very top of your module (before any subroutines)


Global Const BIF_RETURNONLYFSDIRS As Long = &H1
Global Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Global Const BIF_RETURNFSANCESTORS As Long = &H8
Global Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Global Const BIF_BROWSEFORPRINTER As Long = &H2000
Global Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Global Const MAX_PATH As Long = 260
Type BrowseInfo
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszINSTRUCTIONS As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type
Declare Function SHGetPathFromIDListA Lib "shell32.dll" ( _
ByVal pidl As Long, _
ByVal pszBuffer As String) As Long
Declare Function SHBrowseForFolderA Lib "shell32.dll" ( _
lpBrowseInfo As BrowseInfo) As Long


Put this function on the bottom of the module:


'************************************************************************** *********************
' This function gives the user a dir selection box to allow them to choose the location *
'************************************************************************** *********************
Function BrowseFolder(Optional Caption As String = "") As String
Dim BrowseInfo As BrowseInfo
Dim FolderName As String
Dim ID As Long
Dim Res As Long
With BrowseInfo
.hOwner = 0
.pidlRoot = 0
.pszDisplayName = String$(MAX_PATH, vbNullChar)
.lpszINSTRUCTIONS = Caption
.ulFlags = BIF_RETURNONLYFSDIRS
.lpfn = 0
End With
FolderName = String$(MAX_PATH, vbNullChar)
ID = SHBrowseForFolderA(BrowseInfo)
If ID Then
Res = SHGetPathFromIDListA(ID, FolderName)
If Res Then
BrowseFolder = Left$(FolderName, InStr(FolderName, _
vbNullChar) - 1)
End If
End If
End Function


Then change your code to this:

Dim msg As String
Dim FName As String
Dim direct As String
FName = BrowseFolder("Select A Folder")
Range("I1").Formula = FName
direct = Range("I1")
'Ask user to continue with calc
Dim would As VbMsgBoxResult
would = MsgBox("Verify that file names are in format dil_##_###_##_###. First ## is dilution value in SLM, ### is coflow in SCCM, second ## is acetylene in SCCM and second ###is file number", vbQuestion + vbYesNo)
If would = vbYes Then

Dim textline2a As String
Dim spath As String
Dim file As String
k = 0
LineNum = 0
'spath = "direct"
ChDir direct
file = Dir("*.dps")
Do While file <> ""
'Open "C:\Documents and Settings\SchroP96\Desktop\DPS Data (Summer and Fall2010)\10-06-2010\continuously2\" & file For Input As #1
Open FName & "\" & file For Input As #1

pablo4429
10-25-2010, 06:30 PM
WOW absolutely amazing! Thank you so much, now I just have to figure out how that all works for next time. I had been working on that for a while and was apparently nowhere near the solution. Thanks again, that helped out immensely.

Blade Hunter
10-25-2010, 06:40 PM
WOW absolutely amazing! Thank you so much, now I just have to figure out how that all works for next time. I had been working on that for a while and was apparently nowhere near the solution. Thanks again, that helped out immensely.

No problem, its a pain that there is so much code to select a directory but only one line if you want to select a file but oh well, it works :).

Cheers

Dan

Kenneth Hobs
10-25-2010, 06:45 PM
Here is another method to get a folder name.
Private Sub Test_GetFolder()
MsgBox Get_Folder("Pick One Folder", ThisWorkbook.Path)
End Sub


Private Function Get_Folder(Optional HeaderMsg As String = "", Optional initialFilename As String = "") As String
If HeaderMsg = "" Then HeaderMsg = "Select a Folder"
If initialFilename = "" Then initialFilename = Application.DefaultFilePath
With Application.FileDialog(msoFileDialogFolderPicker)
.initialFilename = initialFilename
.Title = HeaderMsg
If .Show = -1 Then
Get_Folder = .SelectedItems(1)
Else
Get_Folder = ""
End If
End With
End Function