Skip to main content
cancel
Showing results for 
Search instead for 
Did you mean: 
fonmarcelo
Contributor III
Contributor III

Salvar conteúdo do script em determinada pasta, via Macro

Olá!

Tenho o script abaixo, onde, seleciona todos os arquivos com a extensão ".qvw", copia o script e faz uma verificação da data de atualização, se for recente, substitui o backup de script antigo, senão cria um novo. Utilizo para realizar backups de todos os scripts utilizados nos nossos "qvw".

Este backup, é salvo na mesma pasta onde encontra-se o "qvw" (no nosso caso, temos uma pasta para cada arquivo, para melhor organização e controle de versões).

Gostaria de um auxílio, para modificar o script abaixo, com o objetivo de salvar todos os backups em uma mesma pasta (C:Temp, por exemplo).

Desde já agradeço.

Sub Backup

  agora = year(now())&month(now())&day(now())&hour(now())&minute(now())

  ActiveDocument.ClearAll

  ActiveDocument.Fields("File Extension").Select "qvw"

  set varArquivo = ActiveDocument.Fields("Full Path").GetPossibleValues

  for i = 0 to varArquivo.Count-1

  Arquivo =  varArquivo.Item(i).Text

  Set App = ActiveDocument.GetApplication

  Set Doc = App.OpenDoc(Arquivo)

  Set Prop = Doc.GetProperties

  strAtualScript = Prop.Script

  Set FSO = CreateObject("Scripting.FileSystemObject")

  'on error resume next

  If FSO.FileExists(Arquivo&".script") Then

     Set UltScript = FSO.OpenTextFile(Arquivo&".script")

  strUltScript = UltScript.ReadAll

  UltScript.Close

  else

  strUltScript = ""

  End If

  'on error goto 0

  If strUltScript <> strAtualScript then

  Set BackupScript = FSO.OpenTextFile(Arquivo&"."& agora &".script",2,True,0)

     BackupScript.Write strUltScript

     BackupScript.Close

    

     Set BackupScript = FSO.OpenTextFile(Arquivo&".script",2, True, 0)

     BackupScript.Write strAtualScript

     BackupScript.Close

  End If

  Doc.CloseDoc

  Next

End Sub

Labels (2)
1 Solution

Accepted Solutions
nicolett_yuri

Marcelo, em sua tabela que possui a coluna "Full Path", crie uma coluna somente com o nome do qvw chamada File, por exemplo:

Full Path = C:\Arquivos\MeuDashboard.qvw

File = MeuDashboard.qvw

Em seu script, faça as seguintes alterações (negrito):

Sub Backup

  agora = year(now())&month(now())&day(now())&hour(now())&minute(now())

  ActiveDocument.ClearAll

  ActiveDocument.Fields("File Extension").Select "qvw"

  set varNomeArquivo = ActiveDocument.Fields("File").GetPossibleValues

  set varArquivo = ActiveDocument.Fields("Full Path").GetPossibleValues

  for i = 0 to varArquivo.Count-1

  Arquivo =  varArquivo.Item(i).Text 

  NomeArquivo = varNomeArquivo.Item(i).Text

  Set App = ActiveDocument.GetApplication

  Set Doc = App.OpenDoc(Arquivo)

  Set Prop = Doc.GetProperties

  strAtualScript = Prop.Script

  Set FSO = CreateObject("Scripting.FileSystemObject")

  'on error resume next

  If FSO.FileExists(Arquivo&".script") Then

     Set UltScript = FSO.OpenTextFile(Arquivo&".script")

  strUltScript = UltScript.ReadAll

  UltScript.Close

  else

  strUltScript = ""

  End If

  'on error goto 0

  If strUltScript <> strAtualScript then

  Set BackupScript = FSO.OpenTextFile("C:\Temp\" & NomeArquivo&"."& agora &".script",2,True,0)

     BackupScript.Write strUltScript

     BackupScript.Close

  

     Set BackupScript = FSO.OpenTextFile(Arquivo&".script",2, True, 0)

     BackupScript.Write strAtualScript

     BackupScript.Close

  End If

  Doc.CloseDoc

  Next

End Sub

View solution in original post

3 Replies
nicolett_yuri

Marcelo, em sua tabela que possui a coluna "Full Path", crie uma coluna somente com o nome do qvw chamada File, por exemplo:

Full Path = C:\Arquivos\MeuDashboard.qvw

File = MeuDashboard.qvw

Em seu script, faça as seguintes alterações (negrito):

Sub Backup

  agora = year(now())&month(now())&day(now())&hour(now())&minute(now())

  ActiveDocument.ClearAll

  ActiveDocument.Fields("File Extension").Select "qvw"

  set varNomeArquivo = ActiveDocument.Fields("File").GetPossibleValues

  set varArquivo = ActiveDocument.Fields("Full Path").GetPossibleValues

  for i = 0 to varArquivo.Count-1

  Arquivo =  varArquivo.Item(i).Text 

  NomeArquivo = varNomeArquivo.Item(i).Text

  Set App = ActiveDocument.GetApplication

  Set Doc = App.OpenDoc(Arquivo)

  Set Prop = Doc.GetProperties

  strAtualScript = Prop.Script

  Set FSO = CreateObject("Scripting.FileSystemObject")

  'on error resume next

  If FSO.FileExists(Arquivo&".script") Then

     Set UltScript = FSO.OpenTextFile(Arquivo&".script")

  strUltScript = UltScript.ReadAll

  UltScript.Close

  else

  strUltScript = ""

  End If

  'on error goto 0

  If strUltScript <> strAtualScript then

  Set BackupScript = FSO.OpenTextFile("C:\Temp\" & NomeArquivo&"."& agora &".script",2,True,0)

     BackupScript.Write strUltScript

     BackupScript.Close

  

     Set BackupScript = FSO.OpenTextFile(Arquivo&".script",2, True, 0)

     BackupScript.Write strAtualScript

     BackupScript.Close

  End If

  Doc.CloseDoc

  Next

End Sub

nicolett_yuri

Eu não testei, mas acredito que vá funcionar

fonmarcelo
Contributor III
Contributor III
Author

Isso mesmo Yuri!

Funcionou.

Muito obrigado!