Aplicação na Nuvem Thisworkbook.path erro https://d.docs.live.net/

[scmaltez]

Olá,

Migrei minha aplicação VBA para nuvem, mais especificamente para o OneDrive.

Nesta aplicação faço referência à propriedade path de Thisworkbook.

Como a aplicação está agora na nuvem, o valor que é retornado para Thisworkbook.path é https://d.docs.live.net/.......

Em seguida uso a função Chdir(Thisworkbook.path & “\Downloads”) que não aceita “https://d.docs.live.net/......” como válido, teria que algo como “C:\caminho”.

Sei como fazer isso via código alterando “https://d.docs.live.net/....” para o caminho no computar que aponta para o OneDrive, que é “C:\Users\minhacontadeusuário\OneDrive”.

O problema é que o código está muito grande e vai ser difícil e trabalhoso alterar todo o código onde faz referência a caminho de arquivo.

Minha pergunta é:

Tem como fazer o VBA interpretar esse caminho na nuvem “https://d.docs.live.net/....” como sendo a pasta local “C:\Users\minhacontadeusuário\OneDrive” sem que eu tenha que alterar todo o código?

Obrigado.

[demabiath]

Olá,
Sim é possivel, você será que transformar o link "http" em um diretório local, vou anexar o script que você poderá usar como base.

Option Explicit

Private Function Local_Workbook_Name(ByRef wb As Workbook) As String

  Dim Ctr As Long
  Dim objShell As Object
  Dim UserProfilePath As String

  'Check if it looks like a OneDrive location
  If InStr(1, wb.FullName, "https://", vbTextCompare) > 0 Then

    'Replace forward slashes with back slashes
    Local_Workbook_Name = Replace(wb.FullName, "/", "\")

    'Get environment path using vbscript
    Set objShell = CreateObject("WScript.Shell")
    UserProfilePath = objShell.ExpandEnvironmentStrings("%UserProfile%")

      'Trim OneDrive designators
    For Ctr = 1 To 4
       Local_Workbook_Name = Mid(Local_Workbook_Name, InStr(Local_Workbook_Name, "\") + 1)
    Next

      'Construct the name
    Local_Workbook_Name = UserProfilePath & "\OneDrive\" & Local_Workbook_Name

  Else

    Local_Workbook_Name = wb.FullName

  End If

End Function

Private Sub testy()

  MsgBox ActiveWorkbook.FullName & vbCrLf & Local_Workbook_Name(ActiveWorkbook)

End Sub