So I have folder series like "ABC1000, ABD2000, ABE3000,...". With the input I have I need to copy a file from these. The information I have last 4 digit (numbers), these are unique per folder but since I do not know first 3 digits(letters) I need to use wildcard for letters. However I could not make it. And also I know that these all folder starts with "A".
While i <= lastRowTC
pathPD = Dir(pathSource & "\ABB\A*", vbDirectory) & ThisWorkbook.Worksheets("Add Dummy").Cells(i, 22).Value & "\getthisfile.xlsm"
FSO.CopyFile pathPD, pathWE
i = i + 1
Wend
Something more like this maybe:
Dim folderDigits, wsAdd As Worksheet
Set wsAdd = ThisWorkbook.Worksheets("Add Dummy")
While i <= lastRowTC
folderDigits = wsAdd.Cells(i, 22).Value
pathPD = Dir(pathSource & "\ABB\A??" & folderDigits, vbDirectory) & "\getthisfile.xlsm"
FSO.CopyFile pathSource & "\" pathPD, pathWE
i = i + 1
Wend
...if the name of the folder you're looking for is "A" followed by two other characters and then folderDigits
Related
I am trying to clean up some existing code
Sheets("Control").Select
MyDir = Cells(2, 1)
CopySheet = Cells(6, 2)
MyFileName = Dir(MyDir & "wp*.xls")
' when the loop breaks, we know that any subsequent call to Dir implies
' that the file need to be added to the list
While MyFileName <> LastFileName
MyFileName = Dir
Wend
MyFileName = Dir
While MyFileName <> ""
Cells(LastRow + 1, 1) = MyFileName
LastRow = LastRow + 1
MyFileName = Dir
Wend
My question relates to how Dir returns results and if there are any guarantees on the order of results. When using Dir in a loop as above, the code implies that the resultant calls to Dir are ordered by name.
Unless Dir guarantees this, it's a bug which needs to be fixed. The question, does Dir() make any guarantee on the order in which files are returned or is it implicit?
Solution
Based on #Frederic's answer, this is the solution I came up with.
Using this quicksort algorithm in conjunction and a function that returns all files in a folder ...
Dim allFiles As Variant
allFiles = GetFileList(MyDir & "wp*.xls")
If IsArray(allFiles) Then
Call QuickSort(allFiles, LBound(allFiles), UBound(allFiles))
End If
Dim x As Integer
Dim lstFile As String
x = 1
' still need to loop through results to get lastFile
While lstFile <> LastFileName
lstFile = allFiles(x)
x = x + 1
Wend
For i = x To UBound(allFiles)
MyFileName = allFiles(i)
Cells(LastRow + 1, 1) = MyFileName
LastRow = LastRow + 1
Next i
There's no guarantee that Dir() will return the files in any particular order. The MS Access VBA documentation even says:
Tip Because file names are
retrieved in no particular order, you
may want to store returned file names
in an array, and then
sort the array.
I know this post is old but I share the solution I have found for those who are also looking for a short solution.
I write all the filenames in a Excel sheet column and I use a variable which will get the name of the files. Then I run a loop to open each file based on the name retrieved by the variable according to the order they have written in the column.
For Row_Value = 1 To 10
NameFile= Range("N" & Row_Value).Value 'NameFile = "Worbook1"
MyFile = Dir("C\Desktop\Folder1\" & NameFile & ".xlsm")
Next Row_Value
I hope it's clear.
OK, so I have code that will take the data entered in "A3" and open a widows search with "*" + A3's contents. What I need now is when any file is found with that search to find the folder name that houses it. Basically we have prints stored by a random number not associated to the real part number but all the related prints are stored within this random numbered folder.
Example:
C:\Document Control\Master Prints*12345*\printxyz.pdf
If I were to search for "*xyz" and "printxyz.pdf" shows up, I now need the "12345" folder name to populate in a cell.
Here is what im using so far
Sub Macro4()
Dim var As Variant
var = "*" & Range("A3").Value
Call Shell("explorer.exe " & Chr(34) & "search-ms:query=" & var & "&crumb=location:""C:\Document Control\Master Prints" & Chr(34), vbNormalFocus)
End Sub
I did something similar recently. I had words in cell E1 that pertains to files in a folder. So I did an instr on the first 5 letters of that cell as my search then looped through the folder to find the file containing that string.
You should be able to adapt this code to what you need.
Const parentFolder As String = "I:\this\that\"
subFolder = parentFolder & getFoldPath(parentFolder, Left(.Range("E1"), 5)) & "\"
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(subFolder)
For Each oFile In oFolder.Files
If InStr(oFile, Left(.Range("E1"), 5)) > 0 Then
scope = subFolder & oFile.name
End If
Next
I have a problem I've been trying to solve for a while now with no luck...!
I have a backup code which saves a copy of a spreadsheet using the application.savecopyas method.
Trouble is, once this is run all the hyperlinks throughout the workbook become invalid as part of the path is removed. Such as this:
CORRECT PATH - file:///\servername\department\project\model\site\comms\filename.pdf
INCORRECT PATH - file:///\servername\department\project\comms\filename.pdf
The problem only occurs when running the following line of code:
ActiveWorkbook.SaveCopyAs FileName:=FullFileName
Where FullFileName is defined earlier in the code by:
FullFileName = FolderPath & "\" & Format(Now, "yyyy-mm-dd_hh-mm-ss") & " - " & FileName & "." & FileExt
Any ideas why the SaveCopyAs would be affecting my hyperlinks in this strange way?
-
FURTHER INFORMATION - Repair Code also does a similar thing:
I also have a fixing code to repair the broken links, essentially this gets the file name and manually combines the correct folder name and filename and assigns this to each hyperlink.
I have noticed this also, sometimes leaves out part of the File Path, sometime it works, othertimes it does not. I don't change anything in the code between runs.
Sub HyperlinkFix_FromCustomer()
j = 0
Dim GetURL As String
For j = 3 To 1000
If IsEmpty(Cells(j, 2)) = False Then
On Error Resume Next
LinkAddress = Sheets("From Customer").Range("B" & j).Hyperlinks(1).Address
If Cells(j, 2).Hyperlinks.Count < 1 Then
'MsgBox j
GoTo Next1
End If
'Sheets("From Customer").Range("W" & j).Value = linkAddress
Inputstring = LinkAddress
'InputString = Sheets("From Customer").Range("W" & j).Value
I = 0
While InStr(I + 1, Inputstring, "\") > 0
I = InStr(I + 1, Inputstring, "\")
Wend
'Extract the folder path
'If No occurence of path separator is found then assign the default directory path
If I = 0 Then
FolderName = "Error - No Folder"
Else
FolderName = Left(Inputstring, I - 1)
End If
'Extracting the file name
FileName = Right(Inputstring, Len(Inputstring) - I)
YearStr = Right(Inputstring, Len(Inputstring) - I + 5)
YearStr = Left(YearStr, 4)
NewDIR = "department\Project\model\site\comms\"
NewDIR = GETNETWORKPATH("D:") & "\" & NewDIR
CorrectAddress = NewDIR & "\" & YearStr & "\" & FileName
Sheets("From Saab").Hyperlinks.Add Anchor:=Sheets("From customer").Range("B" & j), Address:=CorrectAddress, TextToDisplay:=Sheets("From customer").Range("B" & j).Value
End If
Next1:
Next j
End Sub
I just found a solution for this problem.
Go to File --> Info --> Show All Properties --> Hyperlink Base
Write your drive there e.g.
C:\
I need some fresh eyes. I have been working on this incrementally and go from having it work to broken. At this point my eyes are crossing and I could use some help. Column H in this spreadsheet contains a machine id and column I is a date. I want it to display nothing if both H and I are blank (This is the point where I broke it most recently and decided to ask for help. This logic is not include.) If either H or I but not both have a value, it will display "NO". If both H and I have values, it will call a custom function that will create the directory if it does not already exist. Additionally, I want to display "YES" if the directory is created or exists. All of the functionality was working before I tried to display nothing if both H and I were empty.
This is the formula I am working with:
=IF(COUNTA(H21:I21)<>COLUMNS(H21:I21), "NO",IF(CREATEDIR(CONCATENATE(TEXT(I21,"yyyy"),"\",TEXT(I21,"m-d-yy"),"\",H21))=0,"YES", "NO"))
And this is the VBA function I am using(path details omitted)
Function CREATEDIR(dateId)
If Len(Dir("Z:\pathname\" & dateId, vbDirectory)) = 0 Then
MkDir "Z:\pathname\" & dateId
End If
End Function:
Update your UDF to the following so that it can build the full folder path provided in case it doesn't exist (this will handle both network folder paths such as \\server\folder\subfolders\ as well as local or mapped folder paths such as Z:\pathname\). You'll need to set the sBeginPath to whatever it should actually be:
Function CREATEDIR(dateID) As String
Dim sBeginPath As String
Dim sBuildPath As String
Dim vFolder As Variant
Dim i As Long
sBeginPath = "C:\Test\"
If Right(sBeginPath, 1) <> "\" Then sBeginPath = sBeginPath & "\"
For Each vFolder In Split(sBeginPath & dateID, "\")
If Len(vFolder) > 0 Then
If Len(sBuildPath) = 0 Then
If i > 0 Then
sBuildPath = "\\" & vFolder & "\"
Else
sBuildPath = vFolder
End If
Else
If i > 0 Then
sBuildPath = sBuildPath & vFolder & "\"
i = i + 1
Else
sBuildPath = sBuildPath & "\" & vFolder
End If
End If
If (Len(sBuildPath) > 0) And (i = 0 Or i >= 3) Then
If Len(Dir(sBuildPath, vbDirectory)) = 0 Then MkDir sBuildPath
End If
Else
i = i + 1
End If
Next vFolder
CREATEDIR = "YES"
End Function
Then update your formula to the following (using the CHOOSE method as suggested by #pnuts):
=CHOOSE(COUNTA(H21:I21)+1,"", "NO",CREATEDIR(CONCATENATE(TEXT(I21,"yyyy"),"\",TEXT(I21,"m-d-yy"),"\",H21)))
I created a macro button to open my daily files from a excel production sheet where I have all the my macro button for specific files.
The format for all my files are conventionally the same:
Businese Unit Name: YMCA
Year:2012
Month: April
Week: Week 2
Day: 12
File Name: YMC Template 041212.xlsm
I am having issue with the last excel file name extension.
how do I add the MyDaily Template and MyDateProd along with the .xlsm.
I have this -J:.....\& myDailyTemplate & myDateProd.xlsm") see below for entire file path names.
Sub Open_DailyProd()
Dim myFolderYear As String
Dim myFolderMonth As String
Dim myFolderWeek As String
Dim myFolderDaily As String
Dim myDateProd As String
Dim myBusinessUnit As String
Dim myDailyTemplate As String
myBusinessUnit = Sheet1.Cells(32, 2)
myFolderYear = Sheet1.Cells(11, 2)
myFolderMonth = Sheet1.Cells(12, 2)
myFolderWeek = Sheet1.Cells(13, 2)
myFolderDaily = Sheet1.Cells(14, 2)
myDateProd = Sheet1.Cells(15, 2)
myDailyTemplate = Sheet1.Cells(6, 5)
Application.Workbooks.Open ("J:\IAS\3CMC05HA01\IAC Clients\myBusinessUnit\myFolderYear\myFolderMonth\myFolderWeek\myFolderDaily\& myDailyTemplate & myDateProd.xlsm")
End Sub
Excel is looking for a file called:
"J:\IAS\3CMC05HA01\IAC Clients\myBusinessUnit\myFolderYear\myFolderMonth\myFolderWeek\myFolderDaily\& myDailyTemplate & myDateProd.xlsm"
since that is what is included in the quotes, but from your code, you appear to have a number of variables that are part of this string, you need to take them out of the quotes and concatenate them together. Try something like this:
"J:\IAS\3CMC05HA01\IAC Clients\" & myBusinessUnit & "\" & myFolderYear _
& "\" & myFolderMonth & "\" & myFolderWeek & "\" & myFolderDaily & _
"\" & myDailyTemplate & myDateProd & ".xlsm"
I added the continuation _ to make it more readable onthe screen here, but it is not necessary, you can put everything on one line together if you prefer.
Unless you need all of the myBusinessUnit, myFolderYear, etc variables elsewhere, I would think about doing it in some sort of array and then doing a Join function to concatenate everything. I, personally, find this easier to maintain going forward and easier to see the hierarchy in the folder structure rather than looking at a very long string and trying to find what part of the path is wrong.
Sub Open_DailyProd()
Dim pathParts(1 To 10) As String
Dim path As String
pathParts(1) = "J:"
pathParts(2) = "IAS"
pathParts(3) = "3CMC05HA01"
pathParts(4) = "IAC Clients"
pathParts(5) = Sheet1.Cells(32, 2)
pathParts(6) = Sheet1.Cells(11, 2)
pathParts(7) = Sheet1.Cells(12, 2)
pathParts(8) = Sheet1.Cells(13, 2)
pathParts(9) = Sheet1.Cells(14, 2)
pathParts(10) = Sheet1.Cells(6, 5) & Sheet1.Cells(15, 2) & ".xlsm"
path = Join(pathParts, "\")
Application.Workbooks.Open (path)
End Sub