Obter tags de arquivo no VBA usando o nome do arquivo variável

Question

Estou usando o VBA no Excel para percorrer uma série de arquivos e decidir quais importar. Eu gostaria de decidir quais arquivos para importar usando algo como as tags do arquivo, para que eu não precise abrir todos os arquivos. Estou tentando usar o método GetDetailsOf para obtê-los, mas está falhando sempre que tento usar uma variável para o nome do arquivo.

Este código, usando uma constante para o nome do arquivo, funciona corretamente:

Sub TestTags()
  Dim strPath As String
  Dim strFile As String

  strPath = "C:\Users\XXXX\Documents\Safe Space\MacroTest\"
  strFile = Dir(strPath & "*.xls*")
  Do While strFile <> ""
      Debug.Print GetTags()
      strFile = Dir()
  Loop
End Sub

Function GetTags()
  Const csFile As String = "MyTestFile.xlsx"

  With CreateObject("Shell.Application").Namespace("C:\Users\XXXX\Documents\Safe Space\MacroTest\")
      GetTags = .GetDetailsOf(.Items.Item(csFile), 18)
  End With
End Function

No entanto, quando tento substituir a constante por uma variável passada pela sub-rotina de chamada, recebo um erro. Aqui está o código com falha:

Sub TestTags()
    Dim strPath As String
    Dim strFile As String

    strPath = "C:\Users\XXXX\Documents\Safe Space\MacroTest\"
    strFile = Dir(strPath & "*.xls*")
    Do While strFile <> ""
        Debug.Print GetTags(strFile)
        strFile = Dir()
    Loop
End Sub

Function GetTags(ByVal strFile As String)
    Const csFile As String = "MyTestFile.xlsx"
    Dim i As Integer

    With CreateObject("Shell.Application").Namespace("C:\Users\XXXX\Documents\Safe Space\MacroTest\")
        GetTags = .GetDetailsOf(.Items.Item(strFile), 18)
    End With
End Function

A única coisa que estou mudando é o argumento no método .GetDetailsOf , alternando de uma constante para uma variável. Sempre que é executado, ele pára nessa linha com 'Erro 445: Objeto não suporta esta ação'

O que estou fazendo de errado?

    

Answer 1

EDITAR:

OK. Ainda não é possível calcular com precisão por que o caso 2 não funciona, mas descobri que a maneira "correta" de obter o objeto FolderItem correspondente a strFile (conforme exigido por .GetDetailsOf() ) é usar o método .ParseName() :

Function GetTags(ByVal strFile As String)
    Const csFile As String = "MyTestFile.xlsx"
    Dim i As Integer

    With CreateObject("Shell.Application").Namespace("C:\Users\XXXX\Documents\Safe Space\MacroTest\")
        GetTags = .GetDetailsOf(.ParseName(strFile)), 18)
    End With
End Function

Eu não posso explicar por que ele não funciona, mas eu tenho três soluções possíveis.

1) Use CStr(strFile) em vez de strFile ao chamar .GetDetailsOf() :

Function GetTags(ByVal strFile As String)
    Const csFile As String = "MyTestFile.xlsx"
    Dim i As Integer

    With CreateObject("Shell.Application").Namespace("C:\Users\XXXX\Documents\Safe Space\MacroTest\")
        GetTags = .GetDetailsOf(.Items.Item(CStr(strFile)), 18)
    End With
End Function

ou

2) Altere o tipo de parâmetro de strFile para Variant :

Function GetTags(ByVal strFile As Variant)
    Const csFile As String = "MyTestFile.xlsx"
    Dim i As Integer

    With CreateObject("Shell.Application").Namespace("C:\Users\XXXX\Documents\Safe Space\MacroTest\")
        GetTags = .GetDetailsOf(.Items.Item("" & strFile), 18)
    End With
End Function

ou

3) Concatene uma string nula para strFile ao chamar .GetDetailsOf() :

Function GetTags(ByVal strFile As Variant)
    Const csFile As String = "MyTestFile.xlsx"
    Dim i As Integer

    With CreateObject("Shell.Application").Namespace("C:\Users\XXXX\Documents\Safe Space\MacroTest\")
        GetTags = .GetDetailsOf(.Items.Item("" & strFile), 18)
    End With
End Function

    

Answer 2

A função Dir () NÃO retorna um caminho completo, apenas retorna o nome do arquivo e a extensão. Portanto, ao tentar acessar as tags, você só estará passando o nome de arquivo e a extensão se obtiver o resultado de Dir (). Em vez disso, pre-pend o caminho como mostrado abaixo. Eu mudei o nome da variável passada em GetTags para ajudar a evitar confusão.

Sub TestTags()
    Dim strPath As String
    Dim strFile As String

    strPath = "C:\Users\XXXX\Documents\Safe Space\MacroTest\"
    strFile = Dir(strPath & "*.xls*")
    Do While strFile <> ""
        Debug.Print GetTags(strPath & strFile)
        strFile = Dir()
    Loop
End Sub

Function GetTags(ByVal strFullPath As String)
    With CreateObject("Shell.Application").Namespace("C:\Users\XXXX\Documents\Safe Space\MacroTest\")
        GetTags = .GetDetailsOf(.Items.Item(strFullPath), 18)
    End With
End Function