Editing hyperlink to remove file name from path - vba

I'm trying to alter hyperlinks within an open Outlook email to remove the filename from the path. For example I want A:\test\folder1\file.txt to become A:\test\folder1
We use SharePoint Online to store files and often want to open the file location instead. Modifying the link makes this happen (we have SharePoint mapped as a network share).
This code alters the entire hyperlink. I assume I need to discard everything after the final backslash.
Sub HyperLinkChange()
Dim objDoc As Object
Dim tmpLink As Object
On Error Resume Next
If ActiveInspector.EditorType = olEditorWord Then
' use WordEditor Inspector
Set objDoc = ActiveInspector.WordEditor
For Each tmpLink In objDoc.Hyperlinks
tmpLink.Address = "test123"
Next tmpLink
End If
End Sub

You can use the InStrRev to search for a backslash starting from the end, and Left function to truncate your string. For more detail, see the InStrRev documentation and Left documentation.
After adding an additional variable Dim pos as Long, find the position of the last backslash with pos = InStrRev(tmpLink.Address, "\", , vbTextCompare). This is the postion starting from beginning of the address text, not the end. In your example address A:\test\folder1\file.txt, the position of the last backslash is 16.
Then tmpLink.Address = Left(tmpLink.Address, pos - 1) returns everything to the left of that backslash.

Related

Accessing a folder with only numbers in its name from Outlook VBA?

In an existing mailbox folder hierarchy, there is a folder containing subfolders named "01", "05", "06", etc. Notice that the numbers are not consecutive: "02", "03", "04" are missing in this example. In my VBA code, I need to check whether a folder named, say, "02" exists and if not, create it.
I currently have (stripped to bare minimum):
Dim NameStr as String
NameStr="02"
On Error Resume Next
Set NewSubFolder = ContainerFolder.folders(NameStr)
On Error GoTo 0
If NewSubFolder Is Nothing Then
Set NewSubFolder = ContainerFolder.folders.Add(NameStr)
End If
As long as NameStr contains an alphanumeric string, or a numbers-only string with value larger than the count of items if ContainerFolder (such as "2020"), everything works. However, if NameStr is set to "02" (or other value low enough to be interpeted as sequence number of an existing subfolder), the first set statement, instead of failing and returning Nothing, returns a pointer to the third folder (counting from zero, 02 corresponds to 3rd item) in the container folder. That would be "06" in the example above. No folder named "02" will be created.
Apparently the VBA interpreter "kindly" converts the string "02" to integer 2, and then returns pointer to the third folder. How do I prevent this behaviour?
How do I force Outlook to check for existence of a folder with only digits in its name?
The result of On Error Resume Next is often non-working code. You may want to apply it as a last resort.
Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
'
' If desperate declare as variant
Sub createFolder_MinimalVerifiableExample_Dangerous_OnErrorResumeNext_TheOtherWay()
Dim containerFolder As folder
Dim newSubFolder As folder
Dim nameStr As String
nameStr = "03"
Set containerFolder = Session.GetDefaultFolder(olFolderInbox)
On Error Resume Next
' Bypass error if folder exixts
Set newSubFolder = containerFolder.folders.Add(nameStr)
On Error GoTo 0
End Sub
The Folders takes a string representing the folder name or just an index number. To be sure you will get the folder you can iterate over all subfolders and check the folder name. Following this way you can be sure you will get what you need.
Based on niton's response as well as others' contributions, here is my solution.
Instead of trying to get a pointer to the folder, and if that fails, create the folder, lets try to create the folder first, ignore the error if the folder is already there, and then get the pointer no matter whether the folder pre-existed or was newly created.
Dim containerFolder As folder
Dim newSubFolder As folder
' containerFolder needs to point to a valid folder (code not shown)
Dim nameStr As String
nameStr = "03"
On Error Resume Next
Set newSubFolder = containerFolder.folders.Add(nameStr)
On Error GoTo 0
Set newSubFolder = containerFolder.folders.Item(nameStr)
The .Item part in the last statement is optional.
Many thanks to all contributors!

replace inlineshapes using word VBA

I have a word document with many images in it and I wish to be able to select a file path (in which the new images are located and numbered i.e. 1 to 100) to then replace the existing images with the new images.
I have read a few posts of others retrieving the properties of existing inlineshapes to achieve this, but I have also read people succeeding with the following method which seems much simpler (I just haven't been able to get the code working fully yet). Currently the code will run and replace the last image perfectly fine, but then stops with error '438' - Object doesn't support this property or method when it tries to replace the second last image.
The code is as follows:
Sub Replace_images()
Dim rg As Word.Range
Dim i As Long
Dim doc As Word.Document
Dim path As String
'Ensure pictures are numbered with no leading zeros (in folder) & are .jpg
path = "C:\filepathtopictures\"
Set doc = ActiveDocument
For i = doc.InlineShapes.Count To 1 Step -1
Set rg = doc.InlineShapes(i).Range
doc.InlineShapes(i).Delete
rg = doc.InlineShapes.AddPicture(path & i & ".jpg", False, True, rg)
Next i
End Sub
I don't understand how the using the addpicture doesn't work for the next image when nothing has change from the last image. If someone could please explain why it doesn't work or tell me what needs to be changed that would be great!

store word content in variable

How do I copy the entire content (approx 2 pages) of a Word document in VBA and store in a variable?
I keep trying several things, none of which works:
Dim mainData As String
ThisDocument.Activate
ActiveDocument.WholeStory 'error on this line
mainData = Selection.Text
With 'record macro' I can simulate selecting a piece or the entire text, but I can't simulate storing that into a variable.
The above code throws
'This command is not available because no document is open',
but hadn't I first activated this (the current) document, and then selected it (ActiveDocument.WholeStory)?
Why doesn't this work?
Later edit: I managed to do the selection like this:
Dim sText As String
Application.Selection.ClearFormatting
Application.Selection.WholeStory
sText = Application.Selection.Text
MsgBox sText
but the problem is I can't store the entire text (2 pages) in a variable. Part of it is truncated. Would you know how to store word by word (I only need a word at a time anyway)?
Later edit. I applied strReverse on the text to find out the text is actually stored entirely in the variable, just not fully displayed in the message box.
Don't use ThisDocument in code, unless you specifically want to address the file in which the code is stored and running. ThisDocument is the "code name" of that file.
Instead, use ActiveDocument to mean the document currently active in the Word window.
An addition, if you want the Selection in the currently active document, there's no reason to activate it - it's already active.
So to get the entire document content in a string
Dim mainData As String
mainData = ActiveDocument.Content.Text
where Content returns the entire main body's text as a Range object.
Note: The MsgBox has an upper character limit. If you're working with long text strings and want to see what they hold the following has more (but not "infinite") capacity:
Debug.Print mainData
All you need is:
Dim mainData As String
mainData = ActiveDocument.Range.Text

Accessing another word document TextBox

In my word "sheet", I have a CommandButton of which, when clicked, triggers a certain part of code which basically is about opening a second word document and inserting some informations from the current one (Document1) into the second one (Document2) TextBox.
I have String variables containing text in one word document (e.i. Document1). I am opening a second document (e.i. Document2). Then, I need to reach a specific TextBox from the Document2 and insert into it the value of one of the String variables I already have.
That being said, I can't access that second document (Document2) since I always gets the "4160 error" which result of the file name being incorrect.
Therefore, how can I access my second document (Document2) TextBox and insert into it a specific value I already have?
My code as follow (simplified to one variable since it'll be the same for every other):
Private Sub btn1_Click()
Dim strFile As String
Dim WordApp As New Word.Application
Dim WordDoc As Word.Document
Dim name As String
strFile = "C:\Users\WhateverUser\Desktop\WhateverFolder\Document2.docx"
name= txtBoxName.Text
'This comes from the first document (Document1) which is correct.
' Opening another Word document (Document2)
Set WordDoc = WordApp.Documents.Open(strFile)
WordApp.Visible = True
'Here is the problem
'Trying to access the Document2 TextBox (txtBoxNameDoc2) with various ways but I always get the Incorrect File Name Error
'First I tried
Documents("Document2.docx").Bookmarks("txtBoxNameDoc2").Range.Text = name
'Then I tried
Documents("Document2.docx").txtBoxNameDoc2.Text = name
'And after those, I went looking on internet and tried what I could find but none did work.
End Sub
I can speculate at some errors in the coding you have provided above, but if this line works without returning an error:
Set WordDoc = WordApp.Documents.Open(strFile)
WordApp.Visible = True
THen you should be able to do:
WordDoc.Bookmarks(txtBoxNameDoc2).Range.Text = name
This is because you have already opened "Document2.docx" and furthermore you have specifically assigned it to the WordDoc object variable. Because you have done this, you do not need to explicitly reference it from the Documents collection, as you are doing in your original code.
NB: This assumes that txtBoxNameDoc2 is valid string that identifies a bookmark in the WordDoc document. If it should be interpreted as a literal string (i.e., it is the actual name of the bookmark, then you need to qualify it with quotation marks, like:
WordDoc.Bookmarks("txtBoxNameDoc2").Range.Text = name
If this continues to raise an error, then the named bookmark doesn't exist.
It is possible to assign a bookmark to a TextBox object. Bookmarks do not "automatically" exist in a document, so first you have to ensure such a bookmark exists. You can review these and assign them (if they do not exist) through the ribbon).
Bookmarks don't exist unless you create them. You've assumed that the object's name can also refer to a Bookmark, and while it can, first you need to create the bookmark and assign it the name by which you want to refer it.

One Central Header/Footer used by Multiple Docs (Word 2003 or 2007)

Inside Word (2003 or 2007), is there a way to have one Header/Footer that is used by Multiple documents?
I want to be able to change the header/footer in one spot and have it affect multiple documents.
i.e. I have 50 documents and they all have the same header/footer. Instead of opening all 50 documents to make the change, is there a way to link (OLE?) the 50 documents to a main document and only have to change the main document?
If there is not a built in way, has anyone done this using VBA?
I'm not sure how will this will work in practice, but you can insert other files into a Word document as a link.
First create the document with the header/footer content, with the content in the body of the document. Save it.
Then go to one of your 50 documents, go into the header/footer. Go to INSERT | FILE. Locate the first file, then click the little drop-down arrow next to the OPEN button in the Insert File dialog. From the drop-down, select INSERT AS LINK. The content should now show up in the document. If you click in the content, normally it will have a grey background, to indicate it's really a Word field.
Now when you change the first document, you can open the second document, update the field (click anywhere in it and hit F9) and the new content will be pulled in. You can also update fields programmatically pretty easy, or under TOOLS | OPTIONS | PRINT, there's a box to auto update the fields every time the document is printed.
AFAIK to alter a documents header (simply) must be done by having the document open. That said you have a few options. First if the documents are saved in the office XML format then you could open the files using the MSXML library and alter the data in the header. (Or any of the dozens of other ways to alter what is essentially a text file.) If the file(s) are still in the binary format you really only have one of two options. The first is to open the file via vba and alter the header via the document object model. The second would be to figure out the binary format (which is documented) and alter it using the VB6/VBA native binary IO (very non-trivial).
Unless I thought I could gain more time then I was going to lose writing code to alter the documents directly I would probably just loop through all the file in the folder, open them and alter them. As for storing the header somewhere... You could just put the header data in a text file and pull it in. Or keep a document template somewhere.
Here is a very trivial example:
Public Sub Example()
Dim asFiles() As String
Dim lFile As Long
Dim docCrnt As Word.Document
asFiles = GetFiles("C:\Test\", "*.doc")
For lFile = 0& To UBound(asFiles)
Set docCrnt = Word.Documents.Open(asFiles(lFile))
docCrnt.Windows(1).View.SeekView = wdSeekCurrentPageHeader
Selection.Text = "I am the header."
docCrnt.Close True
Next
End Sub
Public Function GetFiles( _
ByVal folderPath As String, _
Optional ByVal pattern As String = vbNullString _
) As String()
Dim sFile As String
Dim sFolder As String
Dim asRtnVal() As String
Dim lIndx As Long
If Right$(folderPath, 1&) = "\" Then
sFolder = folderPath
Else
sFolder = folderPath & "\"
End If
sFile = Dir(sFolder & pattern)
Do While LenB(sFile)
ReDim Preserve asRtnVal(lIndx) As String
asRtnVal(lIndx) = sFolder & sFile
lIndx = lIndx + 1&
sFile = Dir
Loop
If lIndx = 0& Then
ReDim asRtnVal(-1& To -1&) As String
End If
GetFiles = asRtnVal
Erase asRtnVal
End Function