SALVAR ARQUIVO COM O NOME IGUAL AO CONTEUDO DA TAG

FERLUCHINI 26/03/2012 19:27:06
#398349
Pessoal, tenho o seguinte código feito no Outlook com uma regra criada para todo email que chega rodar a script abaixo:

Citação:

Sub SaveAttachments(myMail As MailItem)
Dim vFrom As String, vSubject As String
Dim vFile As Attachment

vFrom = myMail.SenderEmailAddress
vSubject = myMail.Subject

If myMail.Attachments.Count > 0 Then
For i = 1 To myMail.Attachments.Count

Set vFile = myMail.Attachments(i)
If LCase(vFile.FileName) Like [Ô]*.xml[Ô] Then
vFile.SaveAsFile [Ô]C:\Test\[Ô] & Replace(vSubject, [Ô]:[Ô], [Ô][Ô]) + [Ô].xml[Ô]
End If
Next i
End If


Set myMail = Nothing
Set vFile = Nothing
End Sub



Gostaria da ajuda para melhorar este código para fazê-lo ler o conteúdo do anexo [ô].xml[ô] e ao encontrar a tag gravar numa variável para que eu possa utilizá-la como nome do arquivo a ser salvo.

Antecipadamente agradeço a ajuda.
Abaixo segue o xml com a tag chnfe.

Citação:


<?xml version=[Ô]1.0[Ô] encoding=[Ô]utf-8[Ô]?>
<nfeProc versao=[Ô]2.00[Ô] xmlns=[Ô]http://www.portalfiscal.inf.br/nfe[Ô]>
<NFe xmlns=[Ô]http://www.portalfiscal.inf.br/nfe[Ô]>
<infNFe Id=[Ô]NFe35120102634915000265550010000471411400843132[Ô] versao=[Ô]2.00[Ô]>
<ide>
<cUF>35</cUF>
<cNF>40084313</cNF>
<natOp>VENDAS PROPRIAS</natOp>
<indPag>0</indPag>
<mod>55</mod>
<serie>1</serie>
<nNF>47141</nNF>
<dEmi>2012-01-21</dEmi>
<dSaiEnt>2012-01-21</dSaiEnt>
<hSaiEnt>11:08:54</hSaiEnt>
<tpNF>1</tpNF>
<cMunFG>3513504</cMunFG>
<tpImp>1</tpImp>
<tpEmis>1</tpEmis>
<cDV>2</cDV>
<tpAmb>1</tpAmb>
<finNFe>1</finNFe>
<procEmi>0</procEmi>
<verProc>QAD</verProc>
</ide>
<emit>
<CNPJ>02634915000265</CNPJ>
<xNome>COLUMBIAN CHEMICALS BRASIL LTDA</xNome>
<xFant>COLUMBIAN CHEMICALS BRASIL L</xFant>
<enderEmit>
<xLgr>EST RENE FONSECA</xLgr>
<nro>S/N</nro>
<xCpl>POLO INDUSTRIAL</xCpl>
<xBairro>PIACAGUERA</xBairro>
<cMun>3513504</cMun>
<xMun>CUBATAO</xMun>
<UF>SP</UF>
<CEP>11573904</CEP>
<cPais>1058</cPais>
<xPais>BRASIL</xPais>
<fone>1333627100</fone>
</enderEmit>
<IE>283043308116</IE>
<CRT>3</CRT>
</emit>
<dest>
<CNPJ>87870952000144</CNPJ>
<xNome>BORRACHAS VIPAL SA</xNome>
<enderDest>
<xLgr>RUA BUARQUE DE MACEDO, 365</xLgr>
<nro>-</nro>
<xBairro>CENTRO</xBairro>
<cMun>4313300</cMun>
<xMun>NOVA PRATA</xMun>
<UF>RS</UF>
<CEP>95320000</CEP>
<cPais>1058</cPais>
<xPais>BRASIL</xPais>
<fone>542421745</fone>
</enderDest>
<IE>0850007682</IE>
<email>recfiscal.borrachasNP@vipal.com.br,</email>
</dest>
<entrega>
<CNPJ>87870952000144</CNPJ>
<xLgr>RUA BUARQUE DE MACEDO, 365</xLgr>
<nro>_</nro>
<xBairro>CENTRO</xBairro>
<cMun>4313300</cMun>
<xMun>NOVA PRATA</xMun>
<UF>RS</UF>
</entrega>
<det nItem=[Ô]1[Ô]>
<prod>
<cProd>n550-5095</cProd>
<cEAN/>
<xProd>STATEX N550 - BIG BAG(2.20m)</xProd>
<NCM>28030019</NCM>
<CFOP>6101</CFOP>
<uCom>T</uCom>
<qCom>20.6420</qCom>
<vUnCom>6376.3307049914</vUnCom>
<vProd>131620.22</vProd>
<cEANTrib/>
<uTrib>T</uTrib>
<qTrib>20.6420</qTrib>
<vUnTrib>6376.3307049914</vUnTrib>
<indTot>1</indTot>
</prod>
<imposto>
<ICMS>
<ICMS00>
<orig>0</orig>
<CST>00</CST>
<modBC>3</modBC>
<vBC>131620.22</vBC>
<pICMS>12.00</pICMS>
<vICMS>15794.43</vICMS>
</ICMS00>
</ICMS>
<IPI>
<cEnq>999</cEnq>
<IPINT>
<CST>51</CST>
</IPINT>
</IPI>
<PIS>
<PISAliq>
<CST>01</CST>
<vBC>131620.22</vBC>
<pPIS>1.65</pPIS>
<vPIS>2171.73</vPIS>
</PISAliq>
</PIS>
<COFINS>
<COFINSAliq>
<CST>01</CST>
<vBC>131620.22</vBC>
<pCOFINS>7.60</pCOFINS>
<vCOFINS>10003.14</vCOFINS>
</COFINSAliq>
</COFINS>
</imposto>
<infAdProd>_</infAdProd>
</det>
<total>
<ICMSTot>
<vBC>131620.22</vBC>
<vICMS>15794.43</vICMS>
<vBCST>0.00</vBCST>
<vST>0.00</vST>
<vProd>131620.22</vProd>
<vFrete>0.00</vFrete>
<vSeg>0.00</vSeg>
<vDesc>0.00</vDesc>
<vII>0.00</vII>
<vIPI>0.00</vIPI>
<vPIS>2171.73</vPIS>
<vCOFINS>10003.14</vCOFINS>
<vOutro>0.00</vOutro>
<vNF>131620.22</vNF>
</ICMSTot>
<ISSQNtot/>
<retTrib/>
</total>
<transp>
<modFrete>0</modFrete>
<transporta>
<CNPJ>01501729000104</CNPJ>
<xNome>TRANSPORTADORA SANA LTDA</xNome>
<IE>0750031697</IE>
<xEnder>RUA LAURO RICIERI BORTOLON,</xEnder>
<xMun>MARAU</xMun>
<UF>RS</UF>
</transporta>
<veicTransp>
<placa>IKQ7871</placa>
<UF>RS</UF>
</veicTransp>
<vol>
<qVol>20</qVol>
<esp>BAGS</esp>
<pesoL>20642.000</pesoL>
<pesoB>20722.000</pesoB>
</vol>
</transp>
<cobr>
<fat>
<nFat>128039</nFat>
<vOrig>131620.22</vOrig>
<vLiq>131620.22</vLiq>
</fat>
<dup>
<nDup>1</nDup>
<dVenc>2012-01-21</dVenc>
<vDup>131620.22</vDup>
</dup>
</cobr>
<infAdic/>
</infNFe>
<Signature xmlns=[Ô]http://www.w3.org/2000/09/xmldsig#[Ô]>
<SignedInfo>
<CanonicalizationMethod Algorithm=[Ô]http://www.w3.org/TR/2001/REC-xml-c14n-20010315[Ô]/>
<SignatureMethod Algorithm=[Ô]http://www.w3.org/2000/09/xmldsig#rsa-sha1[Ô]/>
<Reference URI=[Ô]#NFe35120102634915000265550010000471411400843132[Ô]>
<Transforms>
<Transform Algorithm=[Ô]http://www.w3.org/2000/09/xmldsig#enveloped-signature[Ô]/>
<Transform Algorithm=[Ô]http://www.w3.org/TR/2001/REC-xml-c14n-20010315[Ô]/>
</Transforms>
<DigestMethod Algorithm=[Ô]http://www.w3.org/2000/09/xmldsig#sha1[Ô]/>
<DigestValue>VW603DYpKw2PInUc631ZCj5jGXM=</DigestValue>
</Reference>
</SignedInfo>
<SignatureValue>OD7CMYzmqsu3dXYJSG/btHwMDy6IPenrzSMxNgdgfYVVKUdJO75gfS1C2FL+5CfBuE5ihv50l8SMz87BkLkwhdM8izbpiRbYRpsY/qzDO2Khrjeq3Yjl8+5ed6QA/fUPSSJG9ilFq6HjQQ/Z2xsVlFRxGp2fTlDLSJg692re23g=</SignatureValue>
<KeyInfo>
<X509Data>
<X509Certificate>MIIGXzCCBUegAwIBAgIIYkDSVFfhdNgwDQYJKoZIhvcNAQEFBQAwdTELMAkGA1UEBhMCQlIxEzARBgNVBAoTCklDUC1CcmFzaWwxNjA0BgNVBAsTLVNlY3JldGFyaWEgZGEgUmVjZWl0YSBGZWRlcmFsIGRvIEJyYXNpbCAtIFJGQjEZMBcGA1UEAxMQQUMgU0VSQVNBIFJGQiB2MTAeFw0xMTEwMjUxNTE4NDBaFw0xMjEwMjQxNTE4NDBaMIHeMQswCQYDVQQGEwJCUjELMAkGA1UECBMCU1AxEDAOBgNVBAcTB0NVQkFUQU8xEzARBgNVBAoTCklDUC1CcmFzaWwxNjA0BgNVBAsTLVNlY3JldGFyaWEgZGEgUmVjZWl0YSBGZWRlcmFsIGRvIEJyYXNpbCAtIFJGQjEWMBQGA1UECxMNUkZCIGUtQ05QSiBBMTESMBAGA1UECxMJQVIgU0VSQVNBMTcwNQYDVQQDEy5DT0xVTUJJQU4gQ0hFTUlDQUxTIEJSQVNJTCBMVERBOjAyNjM0OTE1MDAwMjY1MIGfMA0GCSqGSIb3DQEBAQUAA4GNADCBiQKBgQDTRjavglPQY5Dw8xDnrk4Ivgdh9DoxAyzoHT0aImZDuKYnh9u+8LYm+t8J/Fhu6TO/IOqLI8TmCvTlmwdxrMoJEIjI3D73s0h8nsc90vAk/m7Oby9CPDzlR9uhv+Jq9TPmhejIZWDDRy9rrybdOlZP6YUur+Xl/sU16t53ofnquQIDAQABo4IDCzCCAwcwCQYDVR0TBAIwADAOBgNVHQ8BAf8EBAMCBeAwHQYDVR0lBBYwFAYIKwYBBQUHAwIGCCsGAQUFBwMEMB8GA1UdIwQYMBaAFJrdIrb2d+lCb0jCUUCgVuLzdD+7MIG+BgNVHREEgbYwgbOBIEFESUxTT04uVFJFVklTQU5AQURJVFlBQklSTEEuQ09NoBsGBWBMAQMCoBITEEFESUxTT04gVFJFVklTQU6gGQYFYEwBAwOgEBMOMDI2MzQ5MTUwMDAyNjWgPgYFYEwBAwSgNRMzMDIxMDE5NjQwNjAxNDk2MDg2NDAwMDAwMDAwMDAwMDAwMDAwMDE2Mjc1MzUxU1NQIFNQoBcGBWBMAQMHoA4TDDAwMDAwMDAwMDAwMDBXBgNVHSAEUDBOMEwGBmBMAQIBDTBCMEAGCCsGAQUFBwIBFjRodHRwOi8vd3d3LmNlcnRpZmljYWRvZGlnaXRhbC5jb20uYnIvcmVwb3NpdG9yaW8vZHBjMIHzBgNVHR8EgeswgegwSqBIoEaGRGh0dHA6Ly93d3cuY2VydGlmaWNhZG9kaWdpdGFsLmNvbS5ici9yZXBvc2l0b3Jpby9sY3Ivc2VyYXNhcmZidjEuY3JsMESgQqBAhj5odHRwOi8vbGNyLmNlcnRpZmljYWRvcy5jb20uYnIvcmVwb3NpdG9yaW8vbGNyL3NlcmFzYXJmYnYxLmNybDBUoFKgUIZOaHR0cDovL3JlcG9zaXRvcmlvLmljcGJyYXNpbC5nb3YuYnIvbGNyL1NlcmFzYS9yZXBvc2l0b3Jpby9sY3Ivc2VyYXNhcmZidjEuY3JsMIGZBggrBgEFBQcBAQSBjDCBiTBIBggrBgEFBQcwAoY8aHR0cDovL3d3dy5jZXJ0aWZpY2Fkb2RpZ2l0YWwuY29tLmJyL2NhZGVpYXMvc2VyYXNhcmZidjEucDdiMD0GCCsGAQUFBzABhjFodHRwOi8vb2NzcC5jZXJ0aWZpY2Fkb2RpZ2l0YWwuY29tLmJyL3NlcmFzYXJmYnYxMA0GCSqGSIb3DQEBBQUAA4IBAQBMS8IoCSuLxWgjhBDEjznHAPR+iDf4jR66h2gfDpgAkV1uLQKoWHc0CK/U7h/Z3BknpWAxUOxeYl4SzqtmkEz7JO+vMGq/8j+n4oJiCIm7VL9acvL31P+vLHm6JvRn/TEqmEJRFjX+hgPX/M8tdfdPSEpySaYJQ6fUlJMNxmMmkjoXma+lCMnEIKZjMDOkXOggtIigX8TUyhP73pxfzotDSWPCb7g5MM2h3/1dmG5ILnIIQlTYLIzbnY3qeaarFb98EwFKBa4q5uu2kNw4Rs2E23s3jxPiq30hGhTa3pJqQpIgNrAMhCDUytmvfgwL7hkXVbm6ifMpD+4n2z+Ll73P</X509Certificate>
</X509Data>
</KeyInfo>
</Signature>
</NFe>
<protNFe versao=[Ô]2.00[Ô] xmlns=[Ô]http://www.portalfiscal.inf.br/nfe[Ô]>
<infProt>
<tpAmb>1</tpAmb>
<verAplic>SP_NFE_PL_006j</verAplic>
<chNFe>35120102634915000265550010000471411400843132</chNFe>
<dhRecbto>2012-01-21T11:08:59</dhRecbto>
<nProt>135120037939922</nProt>
<digVal/>
<cStat>100</cStat>
<xMotivo>Autorizado o uso da NF-e</xMotivo>
</infProt>
</protNFe>
</nfeProc>
FERLUCHINI 26/03/2012 19:29:38
#398350
arquivo xml
GANDA.NICK 27/03/2012 02:42:11
#398370
boas, uma solução passa por vc passar o conteudo do *.xml para um array ou string e trabalhar o array\string com as funçoes [txt-color=#e80000]intsr[/txt-color] e [txt-color=#e80000]mid[/txt-color] para fazer a filtragem....



Para passar o conteudo para a string pode usar isto:
Open vFile For Input As #1
    vStr = Input(LOF(1), #1)
Close #1



se precisar de ajuda na função para filtar o que quer diga....

té +
ALEVALE 27/03/2012 08:59:17
#398379
Só eu que não vejo as imagens ?
FERLUCHINI 27/03/2012 09:41:52
#398383
Olá amigo GANDA.
Muito obrigado pela dica... Mas preciso da ajuda para filtrar o conteúdo.
Gostaria de pegar todo o conteúdo que está entre as tags <chnfe> e </chnfe>, que neste exemplo é a sequencia 35120102634915000265550010000471411400843132. Feito isso, armazenar este conteúdo numa variável.

Muito obrigado.
GANDA.NICK 27/03/2012 10:21:00
#398386
veja esta funçao:

Private Function ConteudoTag(ByVal MyStr As String, ByVal vTag As String) As String
Dim vITag As Long, vFTag As Long

vITag = InStr(UCase(MyStr), [Ô]<[Ô] & vTag & [Ô]>[Ô])
vFTag = InStr(UCase(MyStr), [Ô]</[Ô] & vTag & [Ô]>[Ô])

ConteudoTag = Mid$(MyStr, vITag + Len(vTag) + 2, vFTag - (vITag + Len(vTag) + 2))
End Function



MsgBox ConteudoTag(vStr, UCase([Ô]chnfe[Ô]))



bem simples de se fazer... vc não deve é crer é parar para pensar um pouquinho....


espero ter ajudado
FERLUCHINI 28/03/2012 10:01:37
#398478

Caro Ganda, fiz o código abaixo e está 95% funcionando... Ele está indo buscar o conteúdo no xml e salvando com o nome correto, porém ele só funiona qdo defino a variável [ô]nomearq[ô] para um xml que está salvo no hd. Poderia, por favor, me dar uma ajuda para como fazer ele abrir o arquivo direto do anexo do outlook? Obrigado.

Citação:


Sub SaveAttachments(myMail As MailItem)
Dim vFrom As String, vSubject As String
Dim vFile As Attachment
Dim xmlDoc As DOMDocument30
Set xmlDoc = New DOMDocument30

vFrom = myMail.ReceivedByName
vSubject = myMail.Subject

If myMail.Attachments.Count > 0 Then
For i = 1 To myMail.Attachments.Count
Set vFile = myMail.Attachments(i)
Dim nomearq As String
nomearq = [Ô]C:\Test\arq_xml.xml[Ô]
xmlDoc.Load (Trim(nomearq))
Dim id As String
id = xmlDoc.SelectSingleNode([Ô]//nfeProc/protNFe/infProt/chNFe[Ô]).Text

If LCase(vFile.FileName) Like [Ô]*.xml[Ô] Then
vFile.SaveAsFile [Ô]C:\Test\[Ô] & id + [Ô].xml[Ô]
End If
Next i
End If


Set myMail = Nothing
Set vFile = Nothing
End Sub
Tópico encerrado , respostas não são mais permitidas
Voltar