мне нужно установить соединение между двумя книгами в SharePoint

Привет, эксперты!

Пожалуйста, нуждаетесь в вашей поддержке, поскольку я хочу установить соединение между двумя книгами в SharePoint, одна из них предназначена для конечного пользователя, а другая - база данных, соединение успешно работает на моем рабочем столе, но не работает в SharePoint.

заранее спасибо

      Option Explicit
Dim objFSO, objFile As Object
Dim objConnection, objRecordset As Object
Dim LastLocalChange, LastDbUpdate As Date
Dim DbFile, ConnString As String

Sub SyncToDatabase()
DbFile = Sheet1.Range("U5").Value 'Customer Database Location
LastLocalChange = Sheet1.Range("B12").Value
Set objFSO = CreateObject("Scripting.FileSystemObject")
On Error GoTo FileMissing
Set objFile = objFSO.GetFile(DbFile)
If objFile.DateLastModified < LastLocalChange Then 'Local Change was made, update Database
    Kill (DbFile) 'Delete the current database version
    ThisWorkbook.Sheets("CustDb").Copy
    ActiveWorkbook.SaveAs DbFile, FileFormat:=51
    ActiveWorkbook.Close False
End If
Exit Sub
FileMissing:
MsgBox "Please browse for the database file"
BrowseForFile
End Sub

Sub SyncFromDatabase()
LastLocalChange = Sheet1.Range("B12").Value
    DbFile = Sheet1.Range("U5").Value 'Customer Database Location
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    On Error GoTo FileMissing
    Set objFile = objFSO.GetFile(DbFile)
If objFile.DateLastModified > LastLocalChange Then 'Database Change was made, update Local Database
    'Check Last Database Update
    Sheet2.Range("A2:P9999").ClearContents 'Clear existing data
    On Error Resume Next
    Set objConnection = CreateObject("ADODB.Connection")
    Set objRecordset = CreateObject("ADODB.Recordset")
    objConnection.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & Sheet1.Range("U5").Value & ";Extended Properties=""Excel 12.0 Xml;HDR=Yes;IMEX=0"";"
    objRecordset.Open "Select * FROM [CustDb$]", objConnection
    Sheet2.Range("A2").CopyFromRecordset objRecordset
    objRecordset.Close
    objConnection.Close
End If
Exit Sub
FileMissing:
MsgBox "Please browse for the database file"
BrowseForFile
End Sub

0 ответов

Другие вопросы по тегам