The heading may need to be adjusted as it might come across as a duplicate question.
I do apologize for the long winded question.
With the help of these links:
https://www.ozgrid.com/forum/forum/help-forums/excel-general/83263-search-for-file-with-wildcards-and-partial-filename
VBA macro that search for file in multiple subfolders
VBA search for a specific subfolder in many folders and move all the files in it
I have the code below:
Public Sub grab_Folder_Name()
Dim todayDate As String, yesterdayDate As String, folderTime As String, startTime As String, endTime As String
Dim basePath As String, fileName As String
Dim parentFolder As Folder, subFolder1 As Folder, subFolder2 As Folder
Dim myDateArray As Variant
Dim fsoFileSystem As New FileSystemObject
Dim tmpltWkbk As Workbook
Dim kwArray As Variant, sTime As Variant, eTime As Variant
Dim ws1 As Worksheet
Dim i As Long, r As Range
'Set dates to look between
todayDate = Format(DateAdd("d", 0, Date), "dd_mm_YYYY")
yesterdayDate = Format(DateAdd("d", -1, Date), "dd_mm_YYYY")
'Set workbook to work with
Set tmpltWkbk = Workbooks("Template.xlsm")
'Set sheet to work with
Set ws1 = tmpltWkbk.Sheets("Run Results")
'Set default time structure in variable
folderTime = "##.##.##"
'Set date array
myDateArray = Array(todayDate, yesterdayDate)
'Set time Array for Start Time
sTime = Array("18:00:00", "00:00:00")
'Set time Array for End Time
eTime = Array("11:59:00", "06:00:00")
'Get the range to use
Set rng = find_Header("KW ID", "Array")
'Print out array values
'Just for my debugging
ReDim arr(1 To rng.count)
i = 1
For Each r In rng
arr(i) = r.Value
i = i + 1
Next r
kwArray = arr
For i = LBound(kwArray) To UBound(kwArray)
Debug.Print kwArray(i)
Next
'Get the path of the parent folder
basePath = "\\path"
'Set the parent folder
Set parentFolder = fsoFileSystem.GetFolder(basePath)
'Check if the path contains a \ at the end, if not then add it
If Right(basePath, 1) <> "\" Then basePath = basePath & "\"
'Set the directory in a variable
fileName = Dir(basePath, vbDirectory)
'Looop through all the KW
For Each kwID In kwArray
'Loop through all the dates
For Each myDate In myDateArray
'Loop through all the first set of subfolders
For Each subFolder1 In parentFolder.SubFolders
Debug.Print subFolder1.Name
Debug.Print myDate
If subFolder1.Name Like Not "########_##-##-##_##.##.##" Then
'Don't know what to do - Do nothing?
Else
'********** This never seems to be a match **********
'Check if the subFolder1 matches the format
If subFolder1.Name = "########_" & myDate & "_" & folderTime Then
If myDate = todayDate Then
startTime = sTime(1)
endTime = eTime(1)
ElseIf myDate = yesterdayDate Then
startTime = sTime(2)
endTime = eTime(2)
End If
'Check if the subFolder1 is between the times specified
If subFolder1.DateCreated > startTime And subFolder1.DateCreated < endTime Then
'Loop through all the second set of subfolders
For Each subFolder2 In subFolder1.SubFolders
'Check if the subFolder2 matches the format
If subFolder2.Name = "#########_" & kwID & "_" & folderTime Then
With ws1
'.Hyperlinks.Add Anchor:=.Cells.Find(what:=kwID)
'Grab the hyperlink
'Address:=subFolder1.path
'.FollowHyperlink subFolder1.path
'Nothing happens here - The If Condition is not met
Debug.Print subFolder1.Name
End With
End If
Next subFolder2
End If
End If
End If
'This one prints all the folder names in this folder
Debug.Print subFolder1.Name
Next subFolder1
Next myDate
Next kwID
End Sub
Here is a breakdown of what it is I require and what I still need to do:
Create an array of KW ID numbers from a range in the data sheet
Navigate to a folder path for the base folder
Loop through each of the sub-folders looking for the folder name structure that will be: MachineName_Date_Time --> Date(YYYY/MM/DD), Time(HH:MM:SS)
The only dates that are relevant are today and the previous day
The only times that are relevant are Today(00:00:01 --> 06:30:00), Yesterday(18:00:00 --> 00:00:00)
If a folder is found matching the above structure, then I need to go into that folder and loop through those sub folders looking for another folder name structure
The second folder name will be: MachineName_KWID_Time
With this folder name, the only relevant thing is the KWID, which needs to be match for one of the KW ID's stored in the array
The code I am providing so goes up until step 8 - I don't have anything for step 9 - 12 as of yet
If a match is found, I need to then enter that folder and look at the files within
The only file I am looking for, is an image file with PNG extension
If there is an image file in the folder, I need to grab the name of the image file and place that name in a cell in my workbook alongside the KWID value
Once all of this is done, I need to create a hyperlink to this folder - the folder that contains the image - and set the hyperlink to the KWID cell in my workbook
Here are my issues I am experiencing:
The first sub-folder always seems to be MachineName_12-03-2019_08.20.42. There are folders after and before this one, but this one is ALWAYS first
While looping through the folders, it will find dates newer than 12-03-2019, but it does not seem to be searching from latest created date downwards
The myDate variable returns today's date - 15/03/2019 - So I know this is finding the correct date
I'm not sure what validation I should do to check if the the sub-folder name matches the "format" required. There may be a file or folder in the directory that do not match the required folder name format
Because I am unable to move past this if statement: If subFolder1.Name = "########_" & myDate & "_" & folderTime Then, I cannot test what is happening after it
I have commented out the code for grabbing the hyperlink as I am not sure if it is correct and I get an error on this line .Hyperlinks.Add Anchor:=.Cells.Find(what:=kwID)
Argument not optional
If I am able to work through the issues I am experiencing, then I could continue working on the rest of my task and add to the code.
Related
I am trying to write a VBA macro to automatically update an excel column (E) of filenames representing a directory (C:\Directory) with any files (mostly pdf) that might have been added to that directory. This is the code I have so far:
Sub GetFileNames()
Dim sPath As String
Dim sFile As String
Dim Cl As Range
Dim Nme As String
'specify directory
sPath = "C:\Directory\"
With CreateObject("scripting.dictionary")
For Each Cl In Range("E3", Range("E" & Rows.Count).End(xlUp))
.Item(Cl.Value) = Empty
Next Cl
sFile = Dir(sPath)
Do While sFile <> ""
Nme = CreateObject("Scripting.FileSystemObject").GetBaseName(sFile)
If Not .exists(Nme) Then
Range("E" & Rows.Count).End(xlUp).Offset(1).Value = Nme
End If
sFile = Dir ' Get next filename
Loop
End With
End Sub
Unforunatly I am not recieving the expected result. Instead of all missing files being added to the bottom of the column, only one file is added at a time when running the macro. It also adds files that are already in the column (Marked red in the screenshot below). Thanks for the help!
Image showing faulty cells being added
We have a series of Excel workbooks that keep a running total of past transactions for each year. These workbooks each log past transactions, one per row, across 12 worksheets, one for each month. 5-digit numbered tickets with transaction data are scanned daily and saved as .jpg files on our server, and at the end of each row in each workbook is a hyperlink that opens the saved .jpg corresponding to the logged transaction in that particular row.
Each link contains a formula that, along with VBA code that I was able to find, placed in Module1 of the workbook, determines whether or not the .jpg file being referenced actually exists on the server; if the file does exist, the link to the ticket file is displayed as normal, but if it does not exist, "MISSING" is displayed in place of the link. This is the VBA code in Module1:
Function FILEEXISTS(sPath As String)
FILEEXISTS = Dir(sPath) <> ""
End Function
This all works fine, but I would now like to update the ticket link formula to determine if a ticket has been scanned and saved on the server as a .jpg file but is placed in the wrong subfolder. Essentially, what I need is VBA code that would determine if a dynamic (in that it will differ for each line) filename specified in the workbook exists anywhere within any subfolder of the file path on the server for a specific year, and if so, return either "true" if it does, or "false" if it does not. However, I am not experienced enough with VBA to know how to do this myself. If anyone could come up with anything I could use to accomplish this, it would be greatly appreciated. Thanks.
As there is no too much detail regarding your DataSheet structure, try this one:
Sub ListMyFiles(mySourcePath, IncludeSubfolders, File)
Set MyObject = New Scripting.FileSystemObject
Set mySource = MyObject.GetFolder(mySourcePath)
On Error Resume Next
For Each myFile In mySource.Files
'LOOK FOR YOUR FILE WITH A CONDITION THAT EXIT THIS LOOP AND THE NEXT ONE
Next
If IncludeSubfolders Then
For Each mySubFolder In mySource.SubFolders
Call ListMyFiles(mySubFolder.path, True)
Next
End If
End Sub
This code will search for a file (File as string), on a Sourcepath (mySourcePath as string) including or not subfolders (IncludeSubfolders as boolean).
You should include a condition like (example) If myFile.Name = File Then IncludeSubFolders = False, Exit For in order to leave the loop.
I created that one as a procedure, so it is not returning anything, just adjust to your need or make it function.
Hope it helps!
Here's one approach - you will need to adjust for where your data is located etc.
Sub UpdateFileMatches()
Dim c As Range, dictFiles, t, msg, sht As Worksheet
'get all jpg files, starting from the folder root
Set dictFiles = GetMatches("A:\Pictures\Document Pictures\Tickets\", "*.jpg")
MsgBox "Found " & dictFiles.Count & " JPG files"
'loop over worksheets
For Each sht In ActiveWorkbook.Worksheets
'loop over ticket numbers in colA (or wherever)
For Each c In sht.Range("A2:A1000").Cells
t = c.Value
'Is there one or more matching file found?
If Len(t) > 0 And dictFiles.exists(t & ".jpg") Then
msg = "Found " & dictFiles(t & ".jpg") & " file(s)"
Else
msg = "No match found"
End If
c.EntireRow.Cells(1, "J").Value = msg '<< update the row with result
Next c
Next sht
End Sub
'Return a dictionary of unique file names given a starting folder and a file pattern
' e.g. "*.jpg"
'Pass False for last parameter if don't want to check subfolders
Function GetMatches(startFolder As String, filePattern As String, _
Optional subFolders As Boolean = True) As Object
Dim fso, fldr, f, subFldr, nm
Dim dictFiles As Object
Dim colSub As New Collection
Set dictFiles = CreateObject("scripting.dictionary")
Set fso = CreateObject("scripting.filesystemobject")
colSub.Add startFolder
filePattern = LCase(filePattern)
Do While colSub.Count > 0
Set fldr = fso.getfolder(colSub(1))
colSub.Remove 1
'check for files
For Each f In fldr.Files
nm = LCase(f.Name)
If nm Like filePattern Then
dictFiles(nm) = dictFiles(nm) + 1 'count instances
End If
Next f
'check any subfolders
If subFolders Then
For Each subFldr In fldr.subFolders
colSub.Add subFldr.Path
Next subFldr
End If
Loop
Set GetMatches = dictFiles
End Function
I've written some VBA code using file objects to go into a folder, search for particular files (CSV) that meet certain criteria (contain "HR" in filename and created within specified date range), and copy/paste information out of that file into a master file. The master file is typically a compilation of 250+ workbooks.
The macro works as it should, but it takes about 12 minutes to run, which is a bit excessive. I believe it takes so long to run because it is indexing a folder with 30,000+ files in it.
I've copied the relevant lines of my code below, if anyone is aware of any modifications I could make that would decrease the duration of my macro, I would really appreciate it. I'm relatively new to VBA and coding in general, so I'm learning as I go with these sorts of things! Thanks!
Dim FilePath As String
Dim FileName As String
Dim objFSO As FileSystemObject
Dim objFolder As Folder
Dim objFile As file
Dim fileDate As Date
Dim firstDate As Date
Dim secondDate As Date
'Defining the user-input variables
Worksheets("Sheet1").Activate
firstDate = Cells(2, "E").Value
secondDate = Cells(3, "E").Value
'FilePath to information, defining file objects
FilePath = "\\SRV-1\process\DUMP\"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(FilePath)
'Going through Dump folder and finding high resolution files created within the date range
For Each objFile In objFolder.Files
'Checking to see if the file contains the string "HR", indicating high resolution.
If InStr(1, objFile.Name, "HR") Then GoTo Line1 Else GoTo Line3
Line1:
'Storing the file as a variable and checking its creation date
FileName = objFile.Name
OpenFile = FilePath & FileName
fileDate = FileDateTime(OpenFile)
'Checking to see if the file was created between the user input master roll start/end dates
If firstDate < fileDate And secondDate > fileDate Then GoTo Line2 Else GoTo Line3
Line2:
Do stuff: open dump workbook, copy/pase certain range into main workbook, close dump workbook, next objFile
Line3:
Next objFile
This ought to show some improvement, considering the ratio of HR files to total files (250 / 30,000).
Using Dir Function, Minimize reliance on FileSystemObject
The idea here is to use the Dir function first to get a list of all file names that contain the "HR" substring, and only use the FileSystemObject against those files to get the timestamp information -- there's no use incurring the overhead of FSO on every file in that directory.
Then, we process only those files which match the "HR" criteria:
Sub usingDir()
Dim folderPath As String
Dim fileName As String
Dim filesToProcess As New Collection
Dim item As Variant
Dim fileDate As Date
Dim firstDate As Date
Dim secondDate As Date
'Defining the user-input variables
firstDate = Cells(2, "E").Value
secondDate = Cells(3, "E").Value
folderPath = "\\SRV-1\process\DUMP\"
' Gets a collection of files matching the "HR" criteria
fileName = Dir(folderPath)
Do While Not fileName = ""
If InStr(fileName, "HR") > 0 Then
'Only processing files with "HR"
filesToProcess.Add (folderPath & fileName)
End If
fileName = Dir
Loop
'Now we deal only with the "HR" files:
With CreateObject("Scripting.FileSystemObject")
For Each item In filesToProcess
' Check the date last modified
fileDate = .GetFile(item).DateLastModified ' modify as needed
If firstDate < fileDate And secondDate > fileDate Then
'
'
Debug.Print item
'your code to Do Stuff goes here
'
'
'
End If
Next
End With
End Sub
UPDATE: Without Using the FileSystemObject
This was nagging at me, and I figured there must be a way to get the timestamp information without relying on FileSystemObject. There is. We'll still use Dir to traverse the files, but now we'll eliminate any reference to FileSystemObject and replace with some fancy WinAPI function calls. Check out Chip Pearson's article here and download the .bas modules. You'll need the following two files imported to your VBProject:
modGetSetFileTimes
modTimeConversionFunctions
And then you can do something like this:
Option Explicit
Sub withoutFSO()
Dim folderPath As String
Dim FileName As String
Dim filesToProcess As New Collection
Dim item As Variant
Dim fileDate As Date
Dim firstDate As Date
Dim secondDate As Date
'Defining the user-input variables
firstDate = Cells(2, "E").Value
secondDate = Cells(3, "E").Value
folderPath = "\\Your\Path"
' Gets a collection of files matching the "HR" criteria and our Date range
FileName = Dir(folderPath)
Do While Not FileName = ""
'Only processing files with "HR"
If InStr(FileName, "HR") > 0 Then
' Only process files that meet our date criteria
fileDate = CDate(modGetSetFileTimes.GetFileDateTime(CStr(item), FileDateLastModified))
If firstDate < fileDate And secondDate > fileDate Then
filesToProcess.Add (folderPath & FileName)
End If
End If
FileName = Dir
Loop
'Now we deal only with the matching files:
For Each item In filesToProcess
Debug.Print item
Debug.Print fileDate
'your code to Do Stuff goes here
'
'
'
Next
End Sub
This should be an improvement even over my original answer, and, if combined with a more efficient manner of retrieving data (i.e., using ADO instead of Workbooks.Open, if possible) then you should be very optimized.
Take a look at Power Query -- it's a Microsoft add-in for Excel versions 2012 & 2013, and built-in to 2016. Setting up PQ to do this will be amazingly fast, and the 'script' is reusable! No VBA needed.
You can search and combine the multiple files on the specified criteria, but then merge or append to the new/master file, too. For efficiency, rather than processing each file individually, might I suggest gathering up all the data files (by your criteria), combining them to one table, then use the new table to merge/append to the new/master
Hope this helps...
In addition to using the Dir function instead of FileSystemObject, if you cannot automate PowerQuery, and all you need is the data and not the formatting, consider making a direct data connection to the source workbooks using ADODB.
Add a reference to Microsoft ActiveX Data Objects 6.1 Library (via Tools -> References...). There may be versions other than 6.1; choose the highest.
Then you can use something like the following code:
Dim fso As New Scripting.FileSystemObject
Dim filepath As Variant
For Each filepath In filesToProcess
' Check the date last modified
fileDate = fso.GetFile(item).DateLastModified ' modify as needed
If firstDate < fileDate And secondDate > fileDate Then
Dim connectionString As String
connectionString = _
"Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=""" & filepath & """;" & _
"Extended Properties=""Excel 12.0;HDR=No"""
Dim worksheetName As String
worksheetName = "Sheet1"
' There can be multiple worksheets per workbook.
' If you are only interested in one worksheet per workbook, then fill in worksheetName somehow
' Otherwise, you will probably need an inner loop to iterate over all the worksheets
Dim sql As String
sql = _
"SELECT * " & _
"FROM [" & worksheetName & "$]"
Dim rs As New ADODB.Recordset
rs.Open sql, connectionString
destinationWorksheet.Range("A1").CopyFromRecordset rs
rs.Close
Set rs = Nothing
End If
Next
It took a long time because for each interation you pass the information to the main worksheet.
In this case is better use a multidimensional array to keep the information and in the end of the process you pass the the array info in the main worksheet.
I dont know what information you get in each worksheet, soo i cant create an didatical example for you.
I want to create folders with Excel, in a way that every time a make a new entry in the selected column, a new folder is created.
I already searched and found some codes to VBA that creates the folders. But I have to select the cells and then run the macro everytime. Is there any way that I can do that automatically?
Thank you in advance,
Leo
Below is the code for creating new folders (Sub directories)
Sub CreateFolder()
Dim caminho As String
Dim folder As Object, FolderName
For i = 1 To 500
Set folder = CreateObject("Scripting.FileSystemObject") FolderName = ActiveWorkbook.Path & "\" & Range("A" & i).Value
If Not folder.FolderExists(FolderName) Then
folder.CreateFolder (FolderName)
End If
directory = ThisWorkbook.Path
Next i
End Sub
Yes, we can help you. Just need some pertinent info. Does the column need to be selected? Or can you work with a hard coded column? Say a column like Column D... We can put a Worksheet_Change macro on your worksheet module so that whenever a value in a certain column is changed - it will automatically check to see if that folder exists and if not then create it.
Here is an example that will create folders for any new or changed cells in column D:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim caminho As String
Dim folder As Object, FolderName
If Target.Column = 1 And Target.Value <> "" Then ' If Changed Cell is in Column A
' This code changes unacceptable file name characters with an underscore
Filename = Target.Value
MyArray = Array("<", ">", "|", "/", "*", "\", "?", """")
For X = LBound(MyArray) To UBound(MyArray)
Filename = Replace(Filename, MyArray(X), "_", 1)
Next X
' This code creates the folder if it doesn't already exist
Set folder = CreateObject("Scripting.FileSystemObject")
FolderName = ActiveWorkbook.Path & "\" & Filename
If Not folder.FolderExists(FolderName) Then
folder.CreateFolder (FolderName)
End If
End If
End Sub
I'm trying to save excel file into a specific path.
So basically, when I click the button, I'm creating a folder, and want to save the file inside that folder.
The created folder has the current month as name. I'm trying to save into that current month folder.
'Create folder as Month Name. Save filename as date inside "month".
Dim sDate As String = DateTime.Now.ToString("yyyy-MM-dd") & "_" & DateTime.Now.ToString("HH-mm-ss")
Dim sMonth As String = DateTime.Now.ToString("MMMM")
Dim sFolder = Application.StartupPath & "\Resources\Excel\"
My.Computer.FileSystem.CreateDirectory(sFolder & Format(sMonth))
Dim sfinal = Path.Combine(sFolder, sMonth)
xlSh.SaveAs(sfinal & Format(sDate) & ".xlsx")
xlApp.Workbooks.Close()
xlApp.Quit()
As it is, this code doesn't give me any errors. But instead of creating a folder named "March" <-current month and saving inside it, it saves the file in \Excel\ and it also creates folder in the same place.
you could use the following function (similar to .NET System.IO.Path.Combine)
Function PathCombine(path1 As String, path2 As String)
Dim combined As String
combined = path1
If Right$(path1, 1) <> Application.PathSeparator Then
combined = combined & Application.PathSeparator
End If
combined = combined & path2
PathCombine = combined
End Function
Hope this helps!
After long hours of excruciating pain, I've finally did it!
Apparently I was missing an "\"
Since "sMonth" became dynamic name, which later I wanted to use as path, and save files in that folder. I needed to simply put that "\" after sMonth, to tell it to save inside it.
Before I realize this... I've broken down, simplified the code as much as I could so I can logically connect the pieces. What I ended up with, is something slightly different. Now the SaveAS properly saves the file inside the new folder.
Dim sDate As String
sDate = DateTime.Now.ToString("yyyy-MM-dd") & "_" & DateTime.Now.ToString("HH-mm-ss")
Dim sMonth As String
sMonth = DateTime.Now.ToString("MMMM")
Dim sFileName As String
sFileName = sDate + ".xlsx"
Dim sFolder As String
sFolder = Application.StartupPath & "\Resources\Excel\"
Dim sfinal As String
sfinal = (sFolder & sMonth & "\") '<- this thingie here o.O
My.Computer.FileSystem.CreateDirectory(sFolder & Format(sMonth))
xlSh.SaveAs(sfinal & Format(sFileName))
xlApp.Workbooks.Close()
xlApp.Quit()
Thanks for the help.
You don't appear to actually be setting the save path to the created directory. Instead, I believe you're appending the month to the beginning of the file name in the xlSh.SaveAs(sFinal & Format(sDate) & ".xlsx"). Basically (though I'm not sure of the specific command) you need to navigate to the folder you created after you create it. Probably something to the format of
My.Computer.FileSystem.ChangeDirectory(sFolder & Format(sMonth))
though I don't know that that specific command actually exists as I wrote it.
To those who have been wondering wtf I was doing with all this, here is the full sub. And if anyone needs something similar. Thanks for the support. Problem has been resolved.
Private Sub Button_Click(sender As Object, e As EventArgs) Handles Button.Click
Dim xlApp As Excel.Application
Dim xlSh As Excel.Worksheet
xlApp = New Excel.Application
xlApp.Workbooks.Add()
xlSh = xlApp.Workbooks(1).Worksheets(1)
'Items from listbox1 to be exported into excel, second row, second column.
Dim row As Integer = 2
Dim col As Integer = 2
For i As Integer = 0 To ListBox1.Items.Count - 1
xlSh.Cells(row, col) = ListBox1.Items(i)
row = row + 1
Next
row += 1
col = 1
'Items from listbox2 to be exported into excel, second row, third column.
Dim row2 As Integer = 2
Dim col2 As Integer = 3
For i As Integer = 0 To ListBox2.Items.Count - 1
xlSh.Cells(row2, col2) = ListBox2.Items(i)
row2 = row2 + 1
Next
row2 += 1
col2 = 1
'Create folder as Month Name. Save filename as date inside that folder.
'Make filename be yyyy-MM-DD_HH-mm-ss
Dim sDate As String
sDate = DateTime.Now.ToString("yyyy-MM-dd") & "_" & DateTime.Now.ToString("HH-mm-ss")
'This will be used as name for the new folder.
Dim sMonth As String
sMonth = DateTime.Now.ToString("MMMM")
'Filename + extension.
Dim sFileName As String
sFileName = sDate + ".xlsx"
'This is the path.
Dim sFolder As String
sFolder = Application.StartupPath & "\Resources\Excel\"
'This is the path combined with sMonth to make the final path.
Dim sfinal As String
sfinal = (sFolder & sMonth & "\")
'Check if folder with the name sMonth already exists.
If Dir(sFolder, vbDirectory) = sMonth Then
'If it exist, then simply save the file inside the folder.
xlSh.SaveAs(sfinal & Format(sFileName))
Else
'If it doesn't exist:
'This is the creation of sMonth folder, inside "\excel\.
My.Computer.FileSystem.CreateDirectory(sFolder & Format(sMonth))
'This saves the excel file at path sfinal, with filename of sFileName
xlSh.SaveAs(sfinal & Format(sFileName))
End If
'Close everything.
xlApp.Workbooks.Close()
xlApp.Quit()
End Sub
I find this method to be much easier.
Create a FileSystemObject and use BuildPath Method, like so:
Set fs = CreateObject("Scripting.FileSystemObject")
skPath = fs.BuildPath(ActiveDocument.Path, "Survival Story of Sword King")
Attention: ActiveDocument.Path is current directory in Word and does not work in excel or other. for excel it would be ActiveWorkbook.Path
My point is some methods or namespace are application specific.