I am working on some VBA to export data from Excel to a fillable pdf in Adobe Acrobat. I'm following a tutorial from YouTube that accomplishes exactly what I need, just different variable names and ranges obviously. I have the code able to successfully open the pdf template and navigate to the first field, but it isn't entering the text from the specified range. According to what I found it should basically be "tab to get to first field, then type the client name in that field" but it won't type anything. The clients are grouped by households (HHName). Here is the code I have so far
Sub CreatePDFForms()
Dim PDFTemplateFile, NewPDFName, SavePDFFolder, HHName As String
Dim DateRun As Date
Dim HHRow, LastRow As Long
With Sheet1
LastRow = .Range("A999").End(xlUp).Row 'Last Row
PDFTemplateFile = .Range("Z4").Value 'Template File Name
SavePDFFolder = .Range("Z7").Value 'Save PDF Folder
ThisWorkbook.FollowHyperlink PDFTemplateFile
Application.Wait Now + 0.00005
For HHRow = 2 To 2
HHName = .Range("A" & HHRow).Value 'HH Name
DateRun = .Range("B" & HHRow).Value 'Date Run
Application.SendKeys "{Tab}", True
Application.SendKeys HHName, True
Application.Wait Now + 0.00001
Next HHRow
Application.SendKeys "{numlock}%s", True
End With
End Sub
I've tried renaming variables, deleting and retyping. I'm very new to VBA and coding in general so my troubleshooting skills are not that great. Thank you for the help
Related
I have been trying for a while now to edit different code pieces found online to save only the used range of my active workbook as a jpg to my SharePoint online directory. I managed to make a VBA Code work that saves the range as a jpg in a local path but when I change this path to my SharePoint online link it only opens my file explorer and asks me to SaveAs.
I am very new to VBA so I basically have no experience and would therefore be very thankful for any help. Below the VBA Code that does not work right now.
I am pretty sure that the issue lies within the ExportName= ... and ChO.Chart.Export since I took this part from a code that SavesAs to a local path. But like mentioned before I am very new to VBA and therefore have no idea how to recode this to my use case.
Sub SaveAsJPG()
Dim ChO As ChartObject, ExportName As String
Dim CopyRange As Range
Dim Pic As Picture
Dim i As Long
Dim SharePointAdress As String
'My SharePoint Online Adress
SharePointAdress = "https://xxxxxx.sharepoint.com/sites/xxxxx/Shared Documents" & "/"
With ActiveSheet
Set CopyRange = .UsedRange
If Not CopyRange Is Nothing Then
Application.ScreenUpdating = False
ExportName = Application.GetSaveAsFilename(InitialFileName:=SharePointAdress & .Range("A1") & "_" & .Range("J1"), FileFilter:="JPEG Files (*.jpg), *.jpg")
If Not ExportName = "False" Then
CopyRange.Copy
.Pictures.Paste
Set Pic = .Pictures(.Pictures.Count)
Set ChO = .ChartObjects.Add(Left:=10, Top:=10, Width:=Pic.Width, Height:=Pic.Height)
Application.CutCopyMode = False
Do
DoEvents
Pic.Copy
DoEvents
ChO.Chart.Paste
DoEvents
i = i + 1
Loop Until (ChO.Chart.Shapes.Count > 0 Or i > 50)
ChO.Chart.Export Filename:=ExportName, Filtername:="JPG"
ChO.Delete
Pic.Delete
End If
Application.ScreenUpdating = True
End If
End With
End Sub
Range A1 & J1 have the name of the Table & the current calender week inside (so the filename is variable). I do not have the option to connect the SharePoint Link to the network folders.
Thank you for any help for a newbie! :)
I work in bank and we have a lot of restrictions. I can't use the Developer option in Outlook. I can use Excel VBA.
I would like to automate saving a zip file, which is received everyday, in a local drive folder and automatically unzip it and replace the yesterday's file.
I would like to create a button in an Excel sheet. Once I press the button the attachment in Outlook should save in a local folder in whatever destination I want and the attachment should unzip.
I have tried some things saving attachments from Outlook by using VBA, but it doesn't help much.
I am not surprised a bank doesn’t want its emails accessed. You could change the sender, add or remove recipients or change the text. It is difficult to do any of these without leaving a trail but it is possible. You do not want to change anything; you just want to automate saving an attachment so this might be allowed by your tech people and Outlook.
Before attempting the more complicated parts of your requirement, let us check your requirement is possible. I do not know how much you know about Excel VBA. If I ask you to do something you do not understand, come back with questions.
Create a macro-enabled workbook somewhere convenient. The name of the workbook does not matter.
Open the workbook and then the VBA Editor.
Click [Tools] and then [References]. You will get a drop-down menu of all the available libraries. Scroll down until you find “Microsoft Outlook nn.0 Object Library”. “nn” identifies the version of Outlook in use which I understand will be “14” for you. Click the box to the left and a tick will appear. Click [OK]. This will give you access to Outlook from Excel.
In the Project Explorer, you will see something like:
- VBAProject (YourNameForWorkbook.xlsm)
- Microsoft Excel Objects
Sheet1 (Sheet1)
ThisWorkbook
If either of the minuses is a plus, click that plus.
Click [ThisWorkbook]. An empty code area will appear on the right of the VBA Editor window. Copy the code below to this area.
Within the code you will find lines starting ‘###. These lines tell you about changes you must make or things you must check. Make the necessary changes and then save and close the workbook. Reopen the workbook. With good fortune, the macro will run automatically and the default worksheet will report what it has done. It will probably have found the wrong email and saved the wrong attachment. This does not matter. If you can save any attachment, you can save the attachment you want.
Option Explicit
Sub Workbook_Open()
'### Replace "C:\DataArea\SO\" with the name of a disc folder on your system
' Make sure your folder name ends with \.
Const DiscFldrDest As String = "C:\DataArea\SO\"
'### The name of the default worksheet depend on the local language. Replace
' "Sheet1" is this is not the default name for you.
Const WshtOutName As String = "Sheet1"
' ### The subject of the email. Correct if I have misunderstood your comment ' ###
Const Subject As String = "ISIN List: Financial Sanctions - ISIN screening" ' ###
Dim AppOut As Outlook.Application
Dim Found As Boolean
Dim InxA As Long
Dim InxI As Long
Dim OutFldrInbox As Outlook.Folder
Dim RowNext As Long
Dim WshtOut As Worksheet
Set AppOut = CreateObject("Outlook.Application")
With AppOut
With .Session
Set OutFldrInbox = .GetDefaultFolder(olFolderInbox)
End With
End With
Set WshtOut = Worksheets(WshtOutName)
RowNext = WshtOut.Cells(Rows.Count, "A").End(xlUp).Row + 1
'### Change if you prefer different date or time formats
WshtOut.Cells(RowNext, "A").Value = "Macro activated at " & _
Format(Now(), "h:mm") & " on " & _
Format(Now(), "d mmm yy")
RowNext = RowNext + 1
'### GetDefaultFolder is not much use on my system because I have two
' email addresses, each with their own Inbox, neither of which is
' the default Inbox. Probably you only have one work email address
' which is the default for you. To check, the following statement
' outputs the name of the default Inbox's mailbox. Tell me if it is
' not the mail box you want.
WshtOut.Cells(RowNext, "A").Value = Space(6) & "Inbox accessed"
WshtOut.Cells(RowNext, "B").Value = OutFldrInbox.Parent.Name
RowNext = RowNext + 1
Found = False
With OutFldrInbox
For InxI = .Items.Count To 1 Step -1
With .Items(InxI)
If .Subject = Subject And .Attachments.Count > 0 Then '###
WshtOut.Cells(RowNext, "A").Value = Space(6) & "Attachment saved from email" '###
WshtOut.Cells(RowNext, "B").Value = "With subject"
WshtOut.Cells(RowNext, "C").Value = .Subject
RowNext = RowNext + 1
WshtOut.Cells(RowNext, "B").Value = "Received"
'WshtOut.Cells(RowNext, "C").Value = .ReceivedTime
WshtOut.Cells(RowNext, "C").Value = Format(.ReceivedTime, "\a\t h:mm \o\n d mmm yy")
'WshtOut.Cells(RowNext, "C").NumberFormat = "at h:mm on d mmm yy"
RowNext = RowNext + 1
WshtOut.Cells(RowNext, "A").Value = Space(6) & "Attachment saved" '###
For InxA = 1 To .Attachments.Count '###
If UCase(Right$(.Attachments(InxA), 4)) = ".ZIP" Then '###
WshtOut.Cells(RowNext, "B").Value = .Attachments(InxA).Filename '###
.Attachments(1).SaveAsFile DiscFldrDest & .Attachments(1).Filename '###
Found = True '###
Exit For '###
End If '###
Next '###
End If
End With
Next
With WshtOut
If Not Found Then
.Cells(RowNext, "B").Value = "No email with correct subject and a ZIP attachment found"
RowNext = RowNext + 1
End If
.Columns.AutoFit
.Cells(RowNext, "A").Select
End With
End With
End Sub
I am trying to extract the data from a PDF document into a worksheet. The PDFs show and text can be manually copied and pasted into the Excel document.
I am currently doing this through SendKeys and it is not working. I get an error when I try to paste the data from the PDF document. Why is my paste not working? If I paste after the macro has stopped running it pastes as normal.
Dim myPath As String, myExt As String
Dim ws As Worksheet
Dim openPDF As Object
'Dim pasteData As MSForms.DataObject
Dim fCell As Range
'Set pasteData = New MSForms.DataObject
Set ws = Sheets("DATA")
If ws.Cells(ws.Rows.Count, "A").End(xlUp).Row > 1 Then Range("A3:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row).ClearContents
myExt = "\*.pdf"
'When Scan Receipts Button Pressed Scan the selected folder/s for receipts
For Each fCell In Range(ws.Cells(1, 1), ws.Cells(1, ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column))
myPath = Dir(fCell.Value & myExt)
Do While myPath <> ""
myPath = fCell.Value & "\" & myPath
Set openPDF = CreateObject("Shell.Application")
openPDF.Open (myPath)
Application.Wait Now + TimeValue("00:00:2")
SendKeys "^a"
Application.Wait Now + TimeValue("00:00:2")
SendKeys "^c"
'Application.Wait Now + TimeValue("00:00:2")
ws.Select
ActiveSheet.Paste
'pasteData.GetFromClipboard
'ws.Cells(3, 1) = pasteData.GetText
Exit Sub
myPath = Dir
Loop
Next fCell
You can open the PDF file and extract its contents using the Adobe library (which I believe you can download from Adobe as part of the SDK, but it comes with certain versions of Acrobat as well)
Make sure to add the Library to your references too (On my machine it is the Adobe Acrobat 10.0 Type Library, but not sure if that is the newest version)
Even with the Adobe library it is not trivial (you'll need to add your own error-trapping etc):
Function getTextFromPDF(ByVal strFilename As String) As String
Dim objAVDoc As New AcroAVDoc
Dim objPDDoc As New AcroPDDoc
Dim objPage As AcroPDPage
Dim objSelection As AcroPDTextSelect
Dim objHighlight As AcroHiliteList
Dim pageNum As Long
Dim strText As String
strText = ""
If (objAvDoc.Open(strFilename, "") Then
Set objPDDoc = objAVDoc.GetPDDoc
For pageNum = 0 To objPDDoc.GetNumPages() - 1
Set objPage = objPDDoc.AcquirePage(pageNum)
Set objHighlight = New AcroHiliteList
objHighlight.Add 0, 10000 ' Adjust this up if it's not getting all the text on the page
Set objSelection = objPage.CreatePageHilite(objHighlight)
If Not objSelection Is Nothing Then
For tCount = 0 To objSelection.GetNumText - 1
strText = strText & objSelection.GetText(tCount)
Next tCount
End If
Next pageNum
objAVDoc.Close 1
End If
getTextFromPDF = strText
End Function
What this does is essentially the same thing you are trying to do - only using Adobe's own library. It's going through the PDF one page at a time, highlighting all of the text on the page, then dropping it (one text element at a time) into a string.
Keep in mind what you get from this could be full of all kinds of non-printing characters (line feeds, newlines, etc) that could even end up in the middle of what look like contiguous blocks of text, so you may need additional code to clean it up before you can use it.
Hope that helps!
I know this is an old issue but I just had to do this for a project at work, and I am very surprised that nobody has thought of this solution yet:
Just open the .pdf with Microsoft word.
The code is a lot easier to work with when you are trying to extract data from a .docx because it opens in Microsoft Word. Excel and Word play well together because they are both Microsoft programs. In my case, the file of question had to be a .pdf file. Here's the solution I came up with:
Choose the default program to open .pdf files to be Microsoft Word
The first time you open a .pdf file with word, a dialogue box pops up claiming word will need to convert the .pdf into a .docx file. Click the check box in the bottom left stating "do not show this message again" and then click OK.
Create a macro that extracts data from a .docx file. I used MikeD's Code as a resource for this.
Tinker around with the MoveDown, MoveRight, and Find.Execute methods to fit the need of your task.
Yes you could just convert the .pdf file to a .docx file but this is a much simpler solution in my opinion.
Over time, I have found that extracting text from PDFs in a structured format is tough business. However if you are looking for an easy solution, you might want to consider XPDF tool pdftotext.
Pseudocode to extract the text would include:
Using SHELL VBA statement to extract the text from PDF to a temporary file using XPDF
Using sequential file read statements to read the temporary file contents into a string
Pasting the string into Excel
Simplified example below:
Sub ReadIntoExcel(PDFName As String)
'Convert PDF to text
Shell "C:\Utils\pdftotext.exe -layout " & PDFName & " tempfile.txt"
'Read in the text file and write to Excel
Dim TextLine as String
Dim RowNumber as Integer
Dim F1 as Integer
RowNumber = 1
F1 = Freefile()
Open "tempfile.txt" for Input as #F1
While Not EOF(#F1)
Line Input #F1, TextLine
ThisWorkbook.WorkSheets(1).Cells(RowNumber, 1).Value = TextLine
RowNumber = RowNumber + 1
Wend
Close #F1
End Sub
Since I do not prefer to rely on external libraries and/or other programs, I have extended your solution so that it works.
The actual change here is using the GetFromClipboard function instead of Paste which is mainly used to paste a range of cells.
Of course, the downside is that the user must not change focus or intervene during the whole process.
Dim pathPDF As String, textPDF As String
Dim openPDF As Object
Dim objPDF As MsForms.DataObject
pathPDF = "C:\some\path\data.pdf"
Set openPDF = CreateObject("Shell.Application")
openPDF.Open (pathPDF)
'TIME TO WAIT BEFORE/AFTER COPY AND PASTE SENDKEYS
Application.Wait Now + TimeValue("00:00:2")
SendKeys "^a"
Application.Wait Now + TimeValue("00:00:2")
SendKeys "^c"
Application.Wait Now + TimeValue("00:00:1")
AppActivate ActiveWorkbook.Windows(1).Caption
objPDF.GetFromClipboard
textPDF = objPDF.GetText(1)
MsgBox textPDF
If you're interested see my project in github.
Copying and pasting by user interactions emulation could be not reliable (for example, popup appears and it switches the focus). You may be interested in trying the commercial ByteScout PDF Extractor SDK that is specifically designed to extract data from PDF and it works from VBA. It is also capable of extracting data from invoices and tables as CSV using VB code.
Here is the VBA code for Excel to extract text from given locations and save them into cells in the Sheet1:
Private Sub CommandButton1_Click()
' Create TextExtractor object
' Set extractor = CreateObject("Bytescout.PDFExtractor.TextExtractor")
Dim extractor As New Bytescout_PDFExtractor.TextExtractor
extractor.RegistrationName = "demo"
extractor.RegistrationKey = "demo"
' Load sample PDF document
extractor.LoadDocumentFromFile ("c:\sample1.pdf")
' Get page count
pageCount = extractor.GetPageCount()
Dim wb As Workbook
Dim ws As Worksheet
Dim TxtRng As Range
Set wb = ActiveWorkbook
Set ws = wb.Sheets("Sheet1")
For i = 0 To pageCount - 1
RectLeft = 10
RectTop = 10
RectWidth = 100
RectHeight = 100
' check the same text is extracted from returned coordinates
extractor.SetExtractionArea RectLeft, RectTop, RectWidth, RectHeight
' extract text from given area
extractedText = extractor.GetTextFromPage(i)
' insert rows
' Rows(1).Insert shift:=xlShiftDown
' write cell value
Set TxtRng = ws.Range("A" & CStr(i + 2))
TxtRng.Value = extractedText
Next
Set extractor = Nothing
End Sub
Disclosure: I am related to ByteScout
Using Bytescout PDF Extractor SDK is a good option. It is cheap and gives plenty of PDF related functionality. One of the answers above points to the dead page Bytescout on GitHub. I am providing a relevant working sample to extract table from PDF. You may use it to export in any format.
Set extractor = CreateObject("Bytescout.PDFExtractor.StructuredExtractor")
extractor.RegistrationName = "demo"
extractor.RegistrationKey = "demo"
' Load sample PDF document
extractor.LoadDocumentFromFile "../../sample3.pdf"
For ipage = 0 To extractor.GetPageCount() - 1
' starting extraction from page #"
extractor.PrepareStructure ipage
rowCount = extractor.GetRowCount(ipage)
For row = 0 To rowCount - 1
columnCount = extractor.GetColumnCount(ipage, row)
For col = 0 To columnCount-1
WScript.Echo "Cell at page #" +CStr(ipage) + ", row=" & CStr(row) & ", column=" & _
CStr(col) & vbCRLF & extractor.GetCellValue(ipage, row, col)
Next
Next
Next
Many more samples available here: https://github.com/bytescout/pdf-extractor-sdk-samples
To improve the solution of Slinky Sloth I had to add this beforere get from clipboard :
Set objPDF = New MSForms.DataObject
Sadly it didn't worked for a pdf of 10 pages.
This doesn't seem to work with the Adobe Type library. As soon as it gets to Open, I get a 429 error. Acrobat works fine though...
I found a code on the Internet and I've adapted to my own use to automate copy-paste. Works great except that when I paste the Excel chart to my word report, the colors get changed to destination theme. I need to keep source formatting and as the report is final, I can't change the color scheme either.
For some reason Selection.PasteSpecial (wdChart) does not work, it's used as a simple paste. I've got hundreds of reports to paste two dozens of graphs to, please don't say I will have to do it manually! Help please!
'You must set a reference to Microsoft Word Object Library from Tools | References
Option Explicit
Sub ExportToWord()
Dim appWrd As Object
Dim objDoc As Object
Dim FilePath As String
Dim FileName As String
Dim x As Long
Dim LastRow As Long
Dim SheetChart As String
Dim SheetRange As String
Dim BookMarkChart As String
Dim BookMarkRange As String
Dim Prompt As String
Dim Title As String
'Turn some stuff off while the macro is running
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
'Assign the Word file path and name to variables
FilePath = ThisWorkbook.path
FileName = "Trust03.docx"
'Determine the last row of data for our loop
LastRow = Sheets("Summary").Range("A65536").End(xlUp).Row
'Create an instance of Word for us to use
Set appWrd = CreateObject("Word.Application")
'Open our specified Word file, On Error is used in case the file is not there
On Error Resume Next
Set objDoc = appWrd.Documents.Open(FilePath & "\" & FileName)
On Error GoTo 0
'If the file is not found, we need to end the sub and let the user know
If objDoc Is Nothing Then
MsgBox "Unable to find the Word file.", vbCritical, "File Not Found"
appWrd.Quit
Set appWrd = Nothing
Exit Sub
End If
'Copy/Paste Loop starts here
For x = 2 To LastRow
'Use the Status Bar to let the user know what the current progress is
Prompt = "Copying Data: " & x - 1 & " of " & LastRow - 1 & " (" & _
Format((x - 1) / (LastRow - 1), "Percent") & ")"
Application.StatusBar = Prompt
'Assign the worksheet names and bookmark names to a variable
'Use With to group these lines together
With ThisWorkbook.Sheets("Summary")
SheetChart = .Range("A" & x).Text
BookMarkChart = .Range("C" & x).Text
End With
'Tell Word to goto the bookmark assigned to the variable BookMarkChart
appWrd.Selection.Goto What:=wdGoToBookmark, Name:=BookMarkChart
'Copy the data from Thisworkbook
ThisWorkbook.Sheets(SheetChart).ChartObjects(1).Copy
'Paste into Word
appWrd.Selection.PasteSpecial (wdChart)
Next
'Turn everything back on
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.StatusBar = False
'Let the user know the procedure is now complete
Prompt = "The procedure is now completed." & vbCrLf & vbCrLf
Title = "Procedure Completion"
MsgBox Prompt, vbOKOnly + vbInformation, Title
'Make our Word session visible
appWrd.Visible = True
'Clean up
Set appWrd = Nothing
Set objDoc = Nothing
End Sub
Rather than using the Selection.PasteSpecial method I use Application.CommandBars.ExecuteMso ("PasteSourceFormatting")
Change your paste line from
appWrd.Selection.PasteSpecial (wdChart)
to
appWrd.CommandBars.ExecuteMso ("PasteSourceFormatting")
appWrd.CommandBars.ReleaseFocus
Unfortunately MSDN doesn't have much in the way of documentation on this.... Hope it works for you without much trouble
EDIT
After some digging I figured out the the idMso parameter for this method corresponds to the ribbon controls idMso. A complete list of these can be found for each office application by going to File -> Options -> Customize Ribbon and then for each command hover over it in the list and the ToolTip will have a Description followed by a term enclosed in parentheses. This term in the parentheses is the idMso string for that command.
2nd EDIT
So here is how I do it from Excel to PowerPoint:
'Copy the object
Wkst.ChartObjects("ChartName").Select
Wkst.ChartObjects("ChartName").Copy
'Select Slide
Set mySlide = myPresentation.Slides("SlideName")
mySlide.Select
'stall to make sure the slide is selected
For k = 1 To 1000
DoEvents
Next k
'paste on selected slide
PPApp.CommandBars.ExecuteMso ("PasteSourceFormatting")
PPApp.CommandBars.ReleaseFocus
'sit and wait for changes to be made
For k = 1 To 5000
DoEvents
Next k
The wait loops with DoEvents (MSDN) are because this is within a loop pasting a dozen or so charts and then formatting them. I got errors in the next part of the loop (resizing the chart). But here I had to select the silde and wait for a moment before attempting the paste to make sure it was on the right slide. Without this it pasted on slide 1.
Nothing here sticks out to me as something you're ommitting but maybe it will help you see why it is not working.
I have plain text titles in one .csv and hyperlinks for those titles in another .csv
I currently open them in the same work book, put the titles in A, the hyperlinks in H, and use
=HYPERLINK(H1,A1)
to get my final output of Titles with hyperlinks built in.
Is there an easy way (Excel VBA or macro) to bypass the manual work and create a new output file with the "Titles with hyperlinks built in" from the original two .csv files?
Edit: My two .csv files have the respective text (hyperlink and titles) all down column A.
Sub buildlinks()
Dim i As Integer
Dim wb1, wb2 As Workbook
Set wb1 = Application.Workbooks.Open("C:/path/Links.csv")
Set wb2 = Application.Workbooks.Open("C:/path/Titles.csv")
i = 1
Do Until wb1.Sheets("Sheet1Name").Cells(i, 1).Value = ""
ThisWorkbook.Sheets("Sheet1Name").Cells(i, 1).Formula = "=HYPERLINK(" & wb1.Sheets("Sheet1Name").Cells(i, 1).Value & "," & wb2.Sheets("Sheet1Name").Cells(i, 1).Value & ")"
i = i + 1
Loop
End Sub
Assuming you want to create the hyperlinks in the current spreadsheet instead of creating a separate file.
Since you've said that the inputs are really just text files, one item per line, not comma-separated, it's actually pretty simple to implement using the VBA file handling commands.
Sub BuildLinks(titlesFilePath as String, linksFilePath As String, ByVal rowStart As Long)
Dim tf As Long, lf As Long, of As Long
tf = FreeFile
On Error Goto NO_TITLE_FILE
Open titlesFilePath For Input As #tf
lf = FreeFile
On Error Goto NO_LINKS_FILE
Open linksFilePath For Input As #lf
On Error Goto 0
While Not (EOF(tf) Or EOF(lf))
Dim curTitle As String, curLink As String
Line Input #tf, curTitle
Line Input #lf, curLink
Cells(rowStart, 1).Formula = "=HYPERLINK(""" & curLink & """,""" & curTitle & """)"
Wend
Close #tf
Close #lf
Exit Sub
NO_TITLE_FILE:
MsgBox "Can't Open Title File" & titlesFilePath
Exit Sub
NO_LINKS_FILE:
MsgBox "Can't Open Links File" & linksFilePath
End Sub