View Single Post
 
Old 10-27-2021, 02:37 AM
gomezaka gomezaka is offline Windows 10 Office 2019
Novice
 
Join Date: Oct 2021
Posts: 4
gomezaka is on a distinguished road
Default Open excel files from sharepoint by using word wba

My work has changed over to sharepoint, and now I have to open files through sharepoint instead.

I am using Graham Mayor's code, but I cant figure out how to make it work when my excelfile is located on sharepoint. Any help would be apriciated

Sub Highlight_Words_From_Excel_NamedRange()
'Graham Mayor - Graham Mayor - Home Page - Last updated - 20 Mar 2020
Const strWorkbook As String = "C:\Path\Word List.xlsx" 'The workbook path
Const strRange As String = "WordList" 'The named Excel range
Dim arr() As Variant
Dim lngRows As Long
Dim oRng As Range
Dim strFind As String
arr = xlFillArray(strWorkbook, strRange)
For lngRows = 0 To UBound(arr, 2)
strFind = arr(0, lngRows)
Set oRng = ActiveDocument.Range
With oRng.Find
Do While .Execute(findText:=strFind)
oRng.HighlightColorIndex = wdYellow
oRng.Collapse 0
Loop
End With
Next lngRows
lbl_Exit:
Exit Sub
End Sub

Private Function xlFillArray(strWorkbook As String, _
strRange As String) As Variant
'Graham Mayor - Graham Mayor - Home Page - 24/09/2016
Dim RS As Object
Dim CN As Object
Dim iRows As Long

strRange = strRange & "]"
Set CN = CreateObject("ADODB.Connection")

CN.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12 .0;" & _
"Data Source=" & strWorkbook & ";" & _
"Extended Properties=""Excel 12.0 Xml;HDR=NO;IMEX=1"""

Set RS = CreateObject("ADODB.Recordset")
RS.Open "SELECT * FROM [" & strRange, CN, 2, 1

With RS
.MoveLast
iRows = .RecordCount
.MoveFirst
End With
xlFillArray = RS.GetRows(iRows)
If RS.State = 1 Then RS.Close
Set RS = Nothing
If CN.State = 1 Then CN.Close
Set CN = Nothing
lbl_Exit:
Exit Function
End Function
Reply With Quote