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:\
Related
Using 2010 Excel VBA - I need to use look up the image/pdf with the Branch Code as a part of its name at "C:\ECB Test\ECB IR COPY" and paste it at "C:\ECB Test\" RO if it exists. If it doesn't, the program needs to highlight the Branch Code.
(File Name Examples: 28-Kochi-ecb-sdwan completed.pdf, 23 eCB Kozhikode completed.pdf/0036.jpeg)
Having done this manually twice for two other excel sheets (4k+ cells), I decided to Frankenstein a module together and, well, it does not work and I have no idea why.
Sub Sort()
Const SRC_PATH As String = "C:\ECB Test\ECB IR COPY"
Const DEST_PATH As String = "C:\ECB Test"
Dim Row_Number As Integer
Dim fso As Object
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
Dim Folder_Name As String
Dim Branch_Code As String
Dim Final_Path As Variant
Dim File As String
For Row_Number = 3 To 2465
Branch_Code = Worksheets("WAN RFP").Cells(Row_Number, 2)
Folder_Name = Worksheets("WAN RFP").Cells(Row_Number, 5)
On Error Resume Next
File = Dir(SRC_PATH & "\*" & Branch_Code & "*")
Final_Path = Dir(DEST_PATH & "\" & Folder_Name & "\")
If (Len(File) > 0) Then
Call fso.CopyFile(File, Final_Path)
Else
Cells(Row_Number, 2).Interior.ColorIndex = 6
End If
On Error GoTo 0
DoEvents
Next Row_Number
End Sub
I think its unable to use the Branch Code variable as a wildcard, though I might as well have done something silly somewhere in the code. Can someone please help me out?
The problem is you are using the destination path instead of the source path:
File = Dir(DEST_PATH & "*" & Branch_Code & "*.*")
Change it to
File = Dir(SRC_PATH & "*" & Branch_Code & "*.*")
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
I've got a small macro that is supposed to copy a folder and all its contents from one filepath to another. The problem is, it's copying the wrong folder. It instead copies the first subfolder (but not its contents) from that folder and then errors out with a "Path not found" error. Occasionally it will copy the main folder and then just that same first subfolder with none of its contents and then again error out with "Path not found".
Dim strFilePath As String, techfolder As String
strFilePath = "G:\Data\FolderName\PROJECTS\2019\AnotherFolderName\Test_Area\" & year2 & " - Testing\6. Verification\" & quarter & "\3 - Verification Emails Received\YetAnotherFolderName"
techfolder = "G:\Data\CompanyName\FolderName\AnotherFolderName\Name" & year2 & " " & quarter2 & "\Completed\"
Dim FSO As Object
If Right(techfolder, 1) = "\" Then
techfolder = Left(techfolder, Len(techfolder) - 1)
End If
If Right(strFilePath, 1) = "\" Then
strFilePath = Left(strFilePath, Len(strFilePath) - 1)
End If
Set FSO = CreateObject("scripting.filesystemobject")
If FSO.FolderExists(techfolder) = False Then
MsgBox techfolder & " doesn't exist"
Exit Sub
End If
Debug.Print (strFilePath)
Debug.Print (techfolder)
FSO.CopyFolder Source:=techfolder, Destination:=strFilePath
MsgBox "You can find the files and subfolders from " & techfolder & " in " & strFilePath
I've tried a couple different methods of the CopyFolder with if logic, etc. from some internet searches but all in this general form. None of them copy the folder and all its subfolders/contents correctly.
I've checked my filepaths via the debug, they are fine and I can copy/paste them into file explorer and navigate with no issue. Additionally the subfolder copying implies that it seems to be correct.
Manually copying the folder or its subfolder has no issues.
ETA: There are about 31 sub folders and each contains one excel and one pdf.
Variable Values are:
Quarter is Q3 2018
Year2 is 2018
Quarter2 is Q3
Year2 and Quarter2 are made by substrings of Quarter, a variable that is populated via an inputbox.
year2 = Mid(quarter, 4, 4)
quarter2 = Mid(quarter, 1, 2)
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