Automatically save report in SharePoint 365

[Ethvia]

I've done a lot of googling on this but cannot seem to find anything that will work for me.

I use MS Access as a reporting tool from various Oracle databases and it works great for emailing out hundreds of reports a day using autoexec macros and a timer to open the databases. Our company is moving in a direction that won't allow the emails to automatically go out, so I'm trying to find a way to have the reports export to SharePoint 365 where people can go pick them up. I've found several solutions using PowerAutomate, but that won't work for me due to the sheer number of reports and I don't want to write/maintain all of those scripts.

Is there a way, within an Access macro or VBA to export the report (pdf or xlsx) directly to a SharePoint folder? I can do it with OneDrive, but I want a solution that will work for when I retire and OneDrive is associated with my Office account, while SharePoint would work for anyone who has access to those folders.

thanks for reading!

 

[HowdyKeith]

Maybe this will help. I didn't write most of the code, just updated it to send a selected file instead of a bulk upload.

Public Const spurl As String = "http://teams.COMPANYNAME.com/sites/COMPANY/FOLDER/Files/"

Sub testspSendFile()
   Call spSendFile("kstest.xlsx", "C:\Downloads\", "TestUp")
End Sub

Public Sub spSendFile(fPath As String, Optional file As String, Optional DestFName As String, Optional sUrl As String)
    'sUrl is subfolder on sp
    'if file does not exist, then send whole folder
Debug.Print file, sUrl, fPath
'End

On Error GoTo err_Copy

Dim xmlhttp As MSXML2.XMLHTTP60
Dim sharepointUrl
Dim sharepointFileName
Dim tsIn
Dim sBody
Dim LlFileLength As Long
Dim Lvarbin() As Byte
Dim LobjXML As Object
Dim LstrFileName As String
Dim LvarBinData As Variant
Dim PstrFullfileName As String
Dim PstrTargetURL As String
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim fldr
Dim f
Dim pw As String
Dim UserName As String
Dim retval
Dim i As Integer
Dim totFiles As Integer
Dim Start As Date, Finish As Date

Debug.Print file
Debug.Print sUrl

sharepointUrl = spurl

Set LobjXML = CreateObject("Microsoft.XMLHTTP")

If sUrl <> "" Then sUrl = "/" & sUrl
MyPath = sharepointUrl & sUrl
Debug.Print MyPath

LobjXML.Open "HEAD", MyPath, False 'Check for Directory
LobjXML.Send

Debug.Print LobjXML.statusText ' OK

If LobjXML.statusText = "NOT FOUND" Then
    'Create directory if not there
    LobjXML.Open "MKCOL", MyPath, False
    LobjXML.Send
End If

'Set fldr = fso.GetFolder(fPath & "\" & sUrl)
fldr = fPath  '"C:\Downloads\PA_ID_temp\TestUp"

Debug.Print fldr    'C:\Downloads\PA_ID_temp\TestUp

''totFiles = fldr.Files.Count
''For Each f In fldr.Files
''Debug.Print f.name

Dim FNamed As String
    FNamed = file
If DestFName <> "" Then FNamed = DestFName

'  sharepointFileName = sharepointUrl & "/" & sUrl & "/" & f.name
  sharepointFileName = sharepointUrl & sUrl & "/" & FNamed 'f.name
  Debug.Print sharepointFileName

'    PstrFullfileName = fPath & "\" & sUrl & "\" & f.name
    PstrFullfileName = fPath & "\" & file '"C:\Downloads\PA_ID_temp\TestUp\kstest.xlsx" 'fPath & "\" & fnamed 'f.name
    LlFileLength = FileLen(PstrFullfileName) - 1
    Debug.Print PstrFullfileName
    ' Read the file into a byte array.
    If LlFileLength <> 0 Then
      ReDim Lvarbin(LlFileLength)
      Open PstrFullfileName For Binary As #1
      Get #1, , Lvarbin
      Close #1
    End If
    ' Convert to variant to PUT.
    LvarBinData = Lvarbin
'    PstrTargetURL = sharepointUrl & "/" & sUrl & "/" & f.name
    PstrTargetURL = sharepointUrl & sUrl & "/" & FNamed  'f.name

    ' Put the data to the server, false means synchronous.
    LobjXML.Open "PUT", PstrTargetURL, True 'False
   ' Send the file in.
    LobjXML.Send LvarBinData

  'End If

''  I = I + 1
  'RetVal = SysCmd(acSysCmdSetStatus, "File " & I & " of " & totFiles & " copied...")

'Next f

  'RetVal = SysCmd(acSysCmdClearStatus)
  Set LobjXML = Nothing
  Set FSO = Nothing


err_Copy:
If Err <> 0 Then
  MsgBox Err & " " & Err.Description
End If

End Sub