MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    [Resolvido]Upload de arquivos para o OneDrive utilizando MsAccess

    avatar
    edsonsimoes
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 2
    Registrado : 23/07/2012

    [Resolvido]Upload de arquivos para o OneDrive utilizando MsAccess Empty [Resolvido]Upload de arquivos para o OneDrive utilizando MsAccess

    Mensagem  edsonsimoes em 5/8/2020, 19:50

    Prezados, alguém tem um modelo de código para  para fazer upload de arquivos para o OneDrive for Business  utilizando o SharePoint no access ?
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 6956
    Registrado : 15/03/2013

    [Resolvido]Upload de arquivos para o OneDrive utilizando MsAccess Empty Re: [Resolvido]Upload de arquivos para o OneDrive utilizando MsAccess

    Mensagem  ahteixeira em 6/8/2020, 10:27

    Olá Edson, seja Bem-Vindo ao fórum.

    Encontrei o código abaixo numa pesqueisa da net, veja se ajuda:
    Código:
    Public Sub CopyToSharePoint()
    'origem: https://social.msdn.microsoft.com/Forums/office/en-US/1b26aca0-4579-4cc3-bdaa-ea945452db01/upload-files-to-sharepoint-site-via-vba
    On Error GoTo err_Copy

    Dim xmlhttp
    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 As Folder
    Dim f As File
    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

    UserName = InputBox(Username?")
    pw = InputBox("Password?")

    sharepointUrl = "[http path to server]/[server folder to write to]"

    Set LobjXML = CreateObject("Microsoft.XMLHTTP")

    Set fldr = fso.GetFolder(CurrentProject.Path & "\[folder with files to upload]\")
    totFiles = fldr.Files.Count

    For Each f In fldr.Files

      sharepointFileName = sharepointUrl & f.Name

    '****************************   Upload text files  **************************************************

      If Not sharepointFileName Like "*.gif" And Not sharepointFileName Like "*.xls" And Not sharepointFileName Like "*.mpp" Then

        Set tsIn = f.OpenAsTextStream
        sBody = tsIn.ReadAll
        tsIn.Close
     
        Set xmlhttp = CreateObject("MSXML2.XMLHTTP.4.0")
        xmlhttp.Open "PUT", sharepointFileName, False, UserName, Password
        xmlhttp.Send sBody
      
      Else

    '****************************   Upload binary files  **************************************************
     
        PstrFullfileName = CurrentProject.Path & "\[folder with files to upload]\" & f.Name
        LlFileLength = FileLen(PstrFullfileName) - 1

        ' Read the file into a byte array.
        ReDim Lvarbin(LlFileLength)
        Open PstrFullfileName For Binary As #1
        Get #1, , Lvarbin
        Close #1

        ' Convert to variant to PUT.
        LvarBinData = Lvarbin
        PstrTargetURL = sharepointUrl & f.Name


        ' Put the data to the server, false means synchronous.
        LobjXML.Open "PUT", PstrTargetURL, False, Username, Password

       ' 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

    Caso pretenda explorar mais alternativas, veja este:
    officeaccelerators.wordpress.com/2013/11/09/vba-code-to-uploaddownload-files-tofrom-sharepoint-library/

    Abraço
    avatar
    edsonsimoes
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 2
    Registrado : 23/07/2012

    [Resolvido]Upload de arquivos para o OneDrive utilizando MsAccess Empty Re: [Resolvido]Upload de arquivos para o OneDrive utilizando MsAccess

    Mensagem  edsonsimoes em 6/8/2020, 18:20

    AhTeixeira, obrigado pela ajuda!

    A minha necessidade era para enviar um único arquivo. Consegui adaptar e funcionou:

    Código:
    Public Sub UploadOneDriveArquvoUnico()
    On Error GoTo err_Copy

    Dim sharepointFileName
    Dim LlFileLength As Long
    Dim Lvarbin() As Byte
    Dim LstrFileName As String
    Dim LvarBinData As Variant
    Dim PstrFullfileName As String
    Dim PstrTargetURL As String
    Dim fldr As Folder
    Dim Pw As String
    Dim UserName As String
    Dim myURL As String
    Dim WinHttpReq As Object
    Dim OdPasta As String
    Dim OdNomeArquivo As String
    Dim ArquivoOrigem As String


    UserName = "ContaDoOneDrive.onmicrosoft.com"
    Pw = "Informar a senha de acesso"

    '-------------------------------------------------------------------------------------------------------------------
    '1=Link de acesso gerado pelo OneDrive(Cria a conexão que permite o acesso para baixar ou enviar o arquivo)
    myURL = "https:// ContaDoOneDrive -my.sharepoint.com/:f:/g/personal/arquivos_ ContaDoOneDrive _onmicrosoft_com/EhBOZInPXFVAt1cHzznePM7cB85pQgGot_DR_kRP2JenRRg?e=nYJHcc"
    Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
    WinHttpReq.Open "GET", myURL, False, UserName, Pw
    WinHttpReq.Send
    '----------------------------------------------------------------------------------------------------------------------

    OdPasta = "/Documents/NomeDaPastaDeArmazenamento/"
    ArquivoOrigem = “EnderecoDeOrigemDoArquivo”'Local e nome do arquivo

    'SELECIONA O NOME DO ARQUIVO
    Dim intPos As Integer
    Dim IntVezes As Integer
    Dim DescrArqOrig
                       
    Dim IndicItem
    IndicItem = "\"
    intPos = InStrRev(ArquivoOrigem, IndicItem, -1, CaseSensitivo)
    DescrArqOrig = Right(ArquivoOrigem, Len(ArquivoOrigem) - intPos)
    '--------------------------------------------------------------------------------

     OdNomeArquivo = DescrArqOrig

       PstrFullfileName = ArquivoOrigem
       LlFileLength = FileLen(PstrFullfileName) - 1

           'Read the file into a byte array.
           ReDim Lvarbin(LlFileLength)
           Open PstrFullfileName For Binary As #1
           Get #1, , Lvarbin
           Close #1
           'Convert to variant to PUT.
           LvarBinData = Lvarbin
     
       myURL = "https:// ContaDoOneDrive -my.sharepoint.com/personal/arquivos_ ContaDoOneDrive _onmicrosoft_com" & OdPasta & OdNomeArquivo
       WinHttpReq.Open "PUT", myURL, False, UserName, Pw
       WinHttpReq.Send LvarBinData
     
       Set WinHttpReq = Nothing
     

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

    End Sub
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 6956
    Registrado : 15/03/2013

    [Resolvido]Upload de arquivos para o OneDrive utilizando MsAccess Empty Re: [Resolvido]Upload de arquivos para o OneDrive utilizando MsAccess

    Mensagem  ahteixeira em 7/8/2020, 08:42

    Olá Edson,

    Fico feliz por ter ajudado!
    Obrigado por partilhar a sua solução, o fórum agradece.

    Abraço

      Data/hora atual: 29/11/2020, 14:12