[Resolvido]Criar Docs automaticos em sub pastas

Além dos PDF's recebi hoje outra boa notícia!!! Os clientes possuem uma check list comum a todos os processos que derem entrada no tribunal. Assim, pretendem que ao criar a Pasta do Processo, automaticamente sejam criados uma série de documentos em branco com extensão DOC.

Por exemplo: Ao criar a Pasta C:\Processos\1230002010, que o programa crie de imediato este documento: Procuração.doc e outros sucessivamente que serão comuns a todos os processos.

Agradecia muito se fosse possível criar este procedimento...

Aqui no forum tem um exemplo do JPaulo que cria documentos do Word. Creio que dê para adaptar. Deve estar no Reposítório ou em algum tópico por aí, rsrsrsrs.

Certo, já tentei isso pois tenho os exemplos todos do JPaulo e inclusive adaptei-os para a criação de cartas e outrois documentos. Este caso é diferente e teria que estar associado ao código de ontem no momento ad criação da subpasta:


Dim Msg, Style, Title
Msg = "A Pasta já existe"
Style = "vbCritical"
Title = "Erro"
Dim fso As Object
'habilite a referencia Microsoft Scripting Runtime
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.folderexists("C:\Processos") Then
MsgBox "A pasta já existe, vai ser criada a sub pasta..." & Me.NProcesso.Value, vbExclamation, Erro
Else
MkDir "C:\Processos"
End If
If fso.folderexists("C:\Processos\" & Me.NProcesso.Value) Then
MsgBox "A subpasta" & " " & Me.NProcesso.Value & " " & "já existe, processo cancelado...", vbExclamation, Erro
Exit Sub
Else
MkDir "C:\Processos\" & Me.NProcesso.Value ' se não existir cria a subpasta ALGURES AQUI IRIA RESIDIR O CÓDIGO QUE IRIA CRIAR OS TAIS DOCS COM EXTENSÃO .DOC????Me.Pasta.Value = "C:\Processos" & "\" & Me.NProcesso.Value
Me.Pasta.Requery
End If

Eu aqui;

Este nome Procuração.doc vem de onde ?

É por defeito, ou está numa tabela ?

Para já teste assim;


Dim Msg, Style, Title
Msg = "A Pasta já existe"
Style = "vbCritical"
Title = "Erro"
Dim fso As Object
Dim WordCaminho
Dim oApp As Object
Dim Word As Word.Application
Dim doc As Word.Document
'habilite a referencia Microsoft Scripting Runtime
'habilite a referencia Microsoft Word 11.0 ou 12.0 Ovject Library
'By JPaulo Maximo Access
Set fso = CreateObject("Scripting.FileSystemObject")
Set Word = New Word.Application
Set doc = Word.Documents.Add

If fso.folderexists("C:\Processos") Then
MsgBox "A pasta já existe, vai ser criada a sub pasta..." & Me.NProcesso.Value, vbExclamation, Title
Else
MkDir "C:\Processos"
End If
If fso.folderexists("C:\Processos\" & Me.NProcesso.Value) Then
MsgBox "A subpasta" & " " & Me.NProcesso.Value & " " & "já existe, processo cancelado...", vbCritical, Title
Exit Sub
Else
MkDir "C:\Processos\" & Me.NProcesso.Value ' se não existir cria a subpasta
Me.Pasta.Value = "C:\Processos" & "\" & Me.NProcesso.Value
Me.Pasta.Requery
End If
WordCaminho = ("C:\Processos\" & Me.NProcesso.Value & "\" & "Procuração.docx") 'doc para 2000 e 2003, docx para 2007
doc.saveas WordCaminho
Word.Visible = False
Word.Quit
Set Word = Nothing

Vou testar Mestre mas como não me expliquei bem inicialmente prefiro clarificar primeiro.Esses documentos residem numa pasta em C:\DocumentosAdvo. Dentro dessa Pasta seriam criados os seguintes documentos:
Procuração
Substabelecimento
PagamentoTaxaJustiça
DocumentoConcessãoApoioJudiciário
NomeaçãoOrdemAdvogados
Notificaçãoentremandatários

Todos esses documentos seriam criados a partir da ficha processo com o código que me enviou + o que eu acrescentei (em Bold):

Dim msg, Style, Title
msg = "A Pasta já existe"
Style = "vbCritical"
Title = "Erro"
Dim fso As Object
'habilite a referencia Microsoft scripting Runtime
Set fso = CreateObject("scripting.FileSystemObject")
If fso.folderexists("C:\Processos") Then
MsgBox "A pasta já existe, vai ser criada a sub pasta..." & Me.NProcesso.Value, vbExclamation, Erro
Else
MkDir "C:\Processos"
End If
If fso.folderexists("C:\Processos\" & Me.NProcesso.Value) Then
MsgBox "A subpasta" & " " & Me.NProcesso.Value & " " & "já existe, processo cancelado...", vbExclamation, Erro
Exit Sub
Else
MkDir "C:\Processos\" & Me.NProcesso.Value ' se não existir cria a subpasta
Me.Pasta.Value = "C:\Processos" & "\" & Me.NProcesso.Value
Me.Pasta.Requery
End If
Call MsgBox("Existem documentos que devem ser copiados e modificados na Pasta" & vbCrLf & "Procuração,Pagamento Taxa Justiça,Etc.", vbExclamation, "Docs")
DoCmd.OpenForm "frmCopyMove"

O frmCopyMove é um form que utiliza o seguinte código:

Private Sub Imagem27_Click()
On Error Resume Next
'Create a browse for folder instance
With New sjmFolderDialog
'What to display to the user
.Caption = "Selecionar Pasta de destino"
'Process the dialog
.Execute
If Not .UserCancel Then
'User clicked Ok, so fill our control
'with the return value
Me.DestinationDir = .ReturnDir
End If
End With

End Sub

Private Sub Imagem26_Click()
On Error Resume Next
Const conRuns As Integer = 10
Const conPause_Secs As Single = 0.5
Dim sngStart As Single, intI As Integer
Dim UMmsg As clsUserMessage

Set UMmsg = New clsUserMessage

For intI = 1 To conRuns
UMmsg.NewUserMsg "Running part " & intI & " of " & conRuns
sngStart = Timer
Do While Timer < sngStart + conPause_Secs
DoEvents
Loop
Next intI
Set UMmsg = Nothing
Dim i As Long

'Bail out if no files selected
If Me.ListFiles.ListCount = 0 Then Exit Sub
'
'Create a file operation instance
With New sjmFileOp
If Len(Me.txtCaption & "") > 0 Then
'If we have a caption, set the property
.Caption = Me.txtCaption
End If
'Tell the class which operation to perform
.Action = IIf(Me.grpAction = 1, "COPY", "MOVE")
'
'Set various flags
.NoConfirm = Me.chkNoConfirm
.Silent = Me.chkNoDialog
.RenameOnCollision = Me.chkRename
'
'This will open the dialog over our form
'(form must be popup for this to work)
.hwnd = Me.hwnd
'
'Fill the "from list" using the listbox selections
For i = 0 To Me.ListFiles.ListCount - 1
.FromList.Add Me.ListFiles.ItemData(i)
Next

'Fill the "to list" using the DestinationDir textbox
.ToList.Add Me.DestinationDir
'Process the operation
.Execute

'ReturnCode is zero for success
If .ReturnCode <> 0 Then

End If
End With
Call MsgBox("Copiado com sucesso", vbInformation, "Copia")
End Sub


Private Sub Imagem25_Click()
On Error Resume Next
Dim File As Variant
'
'Create a file open instance
With New sjmFileDialog
'This will open the dialog over our form
'(form must be popup for this to work)
.hwnd = Me.hwnd
'
'What to display to the user (in title bar)
.Caption = "Selecione ficheiros a executar"
'Initial directory
.InitDir = "c:\DocumentosAdvo"
'Add some file filters to the "filter list"
.AddFilter "Text Files", "*.Doc"
.AddFilter "All Files", "*.*"
'
'Set some flags
.FileMustExist = True
.PathMustExist = True
.MultiSelect = True
.NoChangeDir = True
'
'Tell the class which operation to perform
.Action = "Abrir"
'Process the dialog
.Execute
If Not .UserCancel Then
'User clicked Ok, so
'clear the listbox
Me.ListFiles.RowSource = ""
'and fill it with return value(s)
For Each File In .FileList
Me.ListFiles.RowSource = _
Me.ListFiles.RowSource & .ReturnDir & File & ";"
Next
End If
End With
btnBrowseDir.Enabled = True
End Sub

Private Sub Rótulo0_Click()
DoCmd.Close
End Sub

Ou seja, esse form copia o(s) documento(s) seleccionado(s) para a Pasta com o nº do Processo activo na ficha processo. A única coisa que o utilizador faz é carregar no botão executar pois a papa está toda feita, uma vez que já coloquei o caminho no início e o Folder Dialog abre já com a Pasta DocumentosAdvo aberta. Como sincronizei o frmcopymove com o nº do processo activo o caminho de cópia já está inserido por defeito, então é seleccionar e copiar.

Peço desculpa por este discurso, mas penso que assim será mais fácil de entender. Vou então aguardar que o mestre diga que eu posso exprimentar....Obrigado

Mestre sem querer estou a induzi-lo em erro. oS DOCUMENTOS não são para serem criados na Pasta Principal...(essa é a opção que eu tinha através do copymove...MIL Perdões que a cabeça está cansada....são para serem criados dentro da Pasta de cada processo comforme postei inicialmente Vou tentar explicar melhor:

1-Existem documentos padrão que devem ser associados à Pasta +rocesso durante a criação do Processo. (Procuração...etc)O ideal seria que fossem adicionados a partir da Pasta DocumentosAdvo para a Pasta do Processo activo.

Assim 1- digito o nº do processo 2- clico no botão para criar a Pasta e automaticamente os tais documentos residentes em C:\DocumentosAdvo...iriam ser copiados para dentro da Psata correspondente ao processo criado e evitava o copymove manual. Parece que agora acertei....Desculpe!

Se o amigo já tem o frmCopyMove e tem tudo a funcionar, não entendo onde se situa a duvida.

Você pode chamar todos os códigos utilizando o Call

Call Imagem27_Click
Call Imagem26_Click
Call Imagem25_Click
Call Rótulo0_Click

Seria apenas a substituição do copymove por um procedimento silencioso e sem intervenção do utilizador do gênero:

Copia Procuração.doc para a pasta & nProcesso.value

Copia Procuração.doc para a pasta & nProcesso.value

1º Como vamos saber que este Procuração.doc é do processo 123 ou do 345 ???

Esta procuração está vazia ?

É igual para todos os processos ?

Sim Mestre é igual para todos os processos, só será alterado o nome do cliente. Estes documentos são documentos Padrão e residem em C:\DocumentosAdvo. Esta pasta e os respectivos documentos serão criados durante o processo de instalação.

Agora o utilizador digitou 1232010 (Nº Processo a criar), clicou no botão para criar a pasta (conforme código seu), a pasta foi criada e é aqui que reside a minha questão...será possível copiar em modo silencioso esses documentos padrão de c:\Documentosadvo para a Pasta do Processo acabado de criar em modo silencioso? Quando o utilizador abri-se a Pasta 1232010 iria encontrar os documentos dentro:
Procuração
Substabelecimento
Documento Único de Cobrança/Pagamento Taxa Justiça
Documento de Concessão de Apoio Judiciário
Nomeação da Ordem dos Advogados
Notificação entre mandatários

Obrigado

teste;


Se for Word 2007, altere para .docx


Dim msg, Style, Title
msg = "A Pasta já existe"
Style = "vbCritical"
Title = "Erro"
Dim fso As Object
'habilite a referencia Microsoft scripting Runtime
Set fso = CreateObject("scripting.FileSystemObject")
If fso.folderexists("C:\Processos") Then
MsgBox "A pasta já existe, vai ser criada a sub pasta..." & Me.NProcesso.Value, vbExclamation, Erro
Else
MkDir "C:\Processos"
End If
If fso.folderexists("C:\Processos\" & Me.NProcesso.Value) Then
MsgBox "A subpasta" & " " & Me.NProcesso.Value & " " & "já existe, processo cancelado...", vbExclamation, Erro
Exit Sub
Else
MkDir "C:\Processos\" & Me.NProcesso.Value ' se não existir cria a subpasta
Me.Pasta.Value = "C:\Processos" & "\" & Me.NProcesso.Value
Me.Pasta.Requery
strDocs1 = "Procuração.doc"
strDocs2 = "Substabelecimento.doc"
strDocs3 = "Documento Único de Cobrança/Pagamento Taxa Justiça.doc"
strDocs4 = "Documento de Concessão de Apoio Judiciário.doc"
strDocs5 = "Nomeação da Ordem dos Advogados.doc"
strDocs6 = "Notificação entre mandatários.doc"
CaminhoOriginal = "c:\DocumentosAdvo\"
CaminhoDestino = "C:\Processos\" & Me.NProcesso.Value & "\"
fso.CopyFile (CaminhoOriginal & strDocs1), CaminhoDestino, True
fso.CopyFile (CaminhoOriginal & strDocs2), CaminhoDestino, True
fso.CopyFile (CaminhoOriginal & strDocs3), CaminhoDestino, True
fso.CopyFile (CaminhoOriginal & strDocs4), CaminhoDestino, True
fso.CopyFile (CaminhoOriginal & strDocs5), CaminhoDestino, True
fso.CopyFile (CaminhoOriginal & strDocs6), CaminhoDestino, True
End If

Mestre:

Criou a Pasta mas deu erro ao efectuar a cópia (Error 53....File not found e foi para a primeira linha aqui:fso.CopyFile (CaminhoOriginal & strDocs1), CaminhoDestino, True

Substitua;

Vai copiar todos os ficheiros que estiverem na pasta c:\DocumentosAdvo\


Dim msg, Style, Title
msg = "A Pasta já existe"
Style = "vbCritical"
Title = "Erro"
Dim fso As Object
'habilite a referencia Microsoft scripting Runtime
Set fso = CreateObject("scripting.FileSystemObject")
If fso.FolderExists("C:\Processos") Then
MsgBox "A pasta já existe, vai ser criada a sub pasta..." & Me.NProcesso.Value, vbExclamation, Erro
Else
MkDir "C:\Processos"
End If
If fso.FolderExists("C:\Processos\" & Me.NProcesso.Value) Then
MsgBox "A subpasta" & " " & Me.NProcesso.Value & " " & "já existe, processo cancelado...", vbExclamation, Erro
Exit Sub
Else
MkDir "C:\Processos\" & Me.NProcesso.Value ' se não existir cria a subpasta
Me.Pasta.Value = "C:\Processos" & "\" & Me.NProcesso.Value
Me.Pasta.Requery
CaminhoOriginal = "c:\DocumentosAdvo\"
CaminhoDestino = "C:\Processos\" & Me.NProcesso.Value & "\"
fso.CopyFile (CaminhoOriginal & "\*.*"), CaminhoDestino, True
End If

100% EFICAZ MESTRE! Logo à primeira, criou a Pasta e mal abri a pasta do processo todos os documentos foram copiados.

MUITO, MUITO OBRIGADO!

Valew;