none
Macro para importar vcf para pst! RRS feed

  • Pergunta

  • Boa tarde pessoal, Bem estava fuçando na net a procura de uma programa free que importasse de uma vez só vários arquivos *.vcf para Ms Outlook 2007 e achei um script que está desta forma: 

    Sub OpenSaveVCard()

    Dim objWSHShell As IWshRuntimeLibrary.IWshShell
    Dim objOL As Outlook.Application
    Dim colInsp As Outlook.Inspectors
    Dim strVCName As String
    Dim fso As Scripting.FileSystemObject
    Dim fsDir As Scripting.Folder
    Dim fsFile As Scripting.File
    Dim vCounter As Integer


    Set fso = New Scripting.FileSystemObject
    Set fsDir = fso.GetFolder("G:\Contato")

    For Each fsFile In fsDir.Files

        strVCName = "G:\Contato\" & fsFile.Name
        Set objOL = CreateObject("Outlook.Application")
        Set colInsp = objOL.Inspectors
            If colInsp.Count = 0 Then
            Set objWSHShell = CreateObject("WScript.Shell")
            objWSHShell.Run strVCName ->> Aqui que o script para acusando o erro descrito abaixo
            Set colInsp = objOL.Inspectors
        If Err = 0 Then
                Do Until colInsp.Count = 1
                    DoEvents
                Loop
                colInsp.Item(1).CurrentItem.Save
                colInsp.Item(1).Close olDiscard
                Set colInsp = Nothing
                Set objOL = Nothing
                Set objWSHShell = Nothing
            End If
        End If

    Next

    End Sub

    O problema e o seguinte a String "strVCName" pega o nome do arquivo vcf, até ai tudo certo, mas como alguns arquivos tem espaço no nome tipo assim "a fulano.vcf", na hora que a função lê dá erro, como eu faço para que está string "strcVCName" lei o nome do arquivo com espaço em branco sem o erro:

    "Erro de tempo de execução '-2147023741 (80070483)': 
    Erro de Automação
    O sistema não pode encontrar o arquivo especifico"

    Fiz o teste tirando o espaço de um arquivo funcionou, mas não dá para tirar de todos são muitos arquivos desta forma, alguém pode me ajudar solucionar este scrip?!!!




                
    • Editado Dacio sexta-feira, 28 de setembro de 2012 20:41
    sexta-feira, 28 de setembro de 2012 20:40

Respostas

  • Dacio,

    Tente colocar a linha de execução entre aspas ("), veja dois exemplos:

    objWSHShell.Run """" & strVCName & """"

    ou

    objWSHShell.Run chr(34) & strVCName & chr(34)


    Fábio de Paula Junior

    sábado, 29 de setembro de 2012 15:35
    Moderador

Todas as Respostas

  • Dacio,

    Tente colocar a linha de execução entre aspas ("), veja dois exemplos:

    objWSHShell.Run """" & strVCName & """"

    ou

    objWSHShell.Run chr(34) & strVCName & chr(34)


    Fábio de Paula Junior

    sábado, 29 de setembro de 2012 15:35
    Moderador
  • Vou fazer os teste e retorno com o resultado!!! Valeu por enquanto Fabio!!!! 

    Abraços

    sábado, 29 de setembro de 2012 22:38
  • Fiz os teste e funcionou tudo certo.. valeu mesmo fabio.. vou deixar aqui o script já atualizado e funcional!!!

    os passos a seguir

    Abra o Ms Outlook eu uso o 2007 vá em Ferramentas -> Macros -> Editor do Visual Basic ou direto ALT+F11(ao mesmo tempo)

    Editor aberto configure ele: Vá em 

    Ferramentas --> Referência -> Marque Microsoft Scripting RunTime e Windows Script Host Obeject Model

    Vá em Inserir --> Modulo

    e e só copiar o código abaixo já atualizado: 

                

    Sub OpenSaveVCard()


    Dim objWSHShell As IWshRuntimeLibrary.IWshShell
    Dim objOL As Outlook.Application
    Dim colInsp As Outlook.Inspectors
    Dim strVCName As String
    Dim fso As Scripting.FileSystemObject
    Dim fsDir As Scripting.Folder
    Dim fsFile As Scripting.File
    Dim vCounter As Integer


    Set fso = New Scripting.FileSystemObject
    Set fsDir = fso.GetFolder("H:\Contato")

    For Each fsFile In fsDir.Files

        strVCName = "H:\Contato\" & fsFile.Name
        Set objOL = CreateObject("Outlook.Application")
        Set colInsp = objOL.Inspectors
            If colInsp.Count = 0 Then
            Set objWSHShell = CreateObject("WScript.Shell")
            objWSHShell.Run Chr(34) & strVCName & Chr(34)
            Set colInsp = objOL.Inspectors
        If Err = 0 Then
                Do Until colInsp.Count = 1
                    DoEvents
                Loop
                colInsp.Item(1).CurrentItem.Save
                colInsp.Item(1).Close olDiscard
                Set colInsp = Nothing
                Set objOL = Nothing
                Set objWSHShell = Nothing
            End If
        End If

    Next

    End Sub

    Espero que tenha ficado claros para todos que forem usar, este script copia contatos que são salvo no formato VCF e adiciona nos contatos do seu Outlook, como agendas salvas de celulares e similares!!

    Obrigado novamente pela ajuda Fabio.



    • Editado Dacio sábado, 29 de setembro de 2012 23:27
    sábado, 29 de setembro de 2012 23:26
  • Obrigado ajudou muito!
    quarta-feira, 2 de setembro de 2015 19:13