Insert text from an excel file into a word document (Word VBA)

[vkhu]

Since my documents usually have certain phrases that can be used over and over again, I want to hotkey them all to save time. To be more specific, I plan to make, let say, Macro1 (insert "Of course"), Macro2 (insert "The issue is"), and Macro3 (insert "by the time"), hotkeyed to Alt +1,2,3 respectively. If I press Alt + 2, "The issue is" got inserted instantly at my cusor.

Here's the base macro I'm using:


Sub Macro1()
Selection.TypeText Text:="sample text"
End Sub


The problem is for any new document, the content of Macro1, 2, and 3 will often need to be changed. I plan on creating an excel file to house all the phrases for ease of edit, but don't know how to link its specific cells back to the word macros. Is there a way to do that?

Note: I'm aware of the AutoText or Building Block function in word, but I don't find them as easy to edit as an excel table.

[gmaxey]

Seems like a Rube Goldburg process to me, but you could collect your Excel defined phrases in an array when the document opens:


Option Explicit
Private m_arrPhrases As Variant
Sub AutoOpen()
Dim strWorkbook As String
Dim lngIndex As Long
strWorkbook = ThisDocument.Path & "\Phrases.xlsx" 'Change to suit your actual Excel path.
If Dir(strWorkbook) = "" Then
MsgBox "Cannot find the designated workbook: " & strWorkbook, vbExclamation
Exit Sub
End If
'Builds array of phrases from a sheet named "Sales Report"
m_arrPhrases = fcnExcelDataToArray(strWorkbook, "Sales Report")
lbl_Exit:
Exit Sub
End Sub
Private Function fcnExcelDataToArray(strWorkbook As String, _
Optional strRange As String = "Sheet1", _
Optional bIsSheet As Boolean = True, _
Optional bHeaderRow As Boolean = True) As Variant
'Default parameters include "Sheet1" as the named sheet, range of the full named sheet and a header row is used.
Dim oRS As Object, oConn As Object
Dim lngRows As Long
Dim strHeaderYES_NO As String
strHeaderYES_NO = "YES"
If Not bHeaderRow Then strHeaderYES_NO = "NO"
If bIsSheet Then strRange = strRange & "$]" Else strRange = strRange & "]"
Set oConn = CreateObject("ADODB.Connection")
oConn.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & strWorkbook & ";" & _
"Extended Properties=""Excel 12.0 Xml;HDR=" & strHeaderYES_NO & """;"
Set oRS = CreateObject("ADODB.Recordset")
oRS.Open "SELECT * FROM [" & strRange, oConn, 2, 1
With oRS
.MoveLast
lngRows = .RecordCount
.MoveFirst
End With
fcnExcelDataToArray = oRS.GetRows(lngRows)
lbl_Exit:
If oRS.State = 1 Then oRS.Close
Set oRS = Nothing
If oConn.State = 1 Then oConn.Close
Set oConn = Nothing
Exit Function
End Function
Sub Macro0()
Selection.InsertAfter m_arrPhrases(0, 0)
End Sub
Sub Macro1()
Selection.InsertAfter m_arrPhrases(0, 1)
End Sub
Sub Macro2()
Selection.InsertAfter m_arrPhrases(0, 2)
End Sub