[Resolvido]Criar Pastas

Boa tarde

Permito-me dirijir-me ao Mestre JPaulo uma vez que o código que estou a usar foi-me enviado por ele. E funciona do 2000 ao 2003, mas no Windows 7 recebo uma mensagem de erro em run time e fecha-me a aplicação. Agradeço ajuda pois já não sei mais o que fazer!

On Error GoTo Err_imgexp_Click
'JPaulo Forum Maximo Access
Dim obj As Object
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFileSystem.GetFolder("C:\Processos\")
Set objSubFolders = objFolder.SubFolders
For Each obj In objSubFolders
If InStr(obj.Name, Me.NProcesso.Value) > 0 Then
Shell "explorer.exe """ & obj.Path & "", vbNormalFocus
Else
End
End If
Next

Gostaria de o ajudar, mas não tenho o Windows Seven para efectuar testes.

Aguardamos por alguma fera, que tenha.

Ok, obrigado

Eu estou usando o Windows 7. Se quiser me enviar para testes, pode enviar. Talvez nem seja problema do SO. Testando a gente fica sabendo.

Obrigado, mas já percebi o que se passa (PENSO!) que está acontecer o seguinte:

Ao criar a Pasta com este código:
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" & Me.NProcesso.Value
End If
MkDir "C:\Processos\" & Me.NProcesso.Value ' se não existir cria a subpasta
Me.Pasta.Value = "C:\Processos" & Me.NProcesso.Value
Me.Pasta.Requery

Aparece assim na caixa Pasta: C:\Processos1234552010, então quando uso o segundo código
que já postei dá erro de run time. SE DIGITAR A BARRA \ ENTRE Processos e o nº processo
já abre...C:\Processos\1234552010...Qual o código a acrescentar a este procedimento para isso? É que eu experimentei o seguite:

FollowHyperlink Me.Pasta.Value e abriu 1 vez sepois deu erros, mas quando digitei a barra passou abrir...como por lá a barra sem que seja o utilizador a fazer isso?

Obrigado

Acrescentei a barra aqui e parece esrar tudo a funcionarno 2003:Me.Pasta.Value "C:\Processos\" & Me.NProcesso.Value

Vou testar no 7 e já dou feedback, certo!

Olhando o código de longe, me parece que só faltava isso mesmo, colocar a barra que separa as pastas.

pois é nas na realidade acontece isto:

1- Se não clocar a Barra no 2003 funciona bem e abre a pasta. Se colocar a Barra então abre o 1º processo, crio um novo e já não abre a Pasta. Se tirar a Barra torna tudo ao normal mas com erros no 7. Preso por ter e preso por não ter...

Não me importo de lhe enviar aplicação, mas como enviar 15MB''' será que o servidor aceita? é que 15MB é compilado através do setup factory. Mas se me disser como enviar e para onde eu envio e só tenho agradecer, pois dentro de uma semana começo a fazer demos em clientes e nem quero pensar nissso........

teste;

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
MkDir "C:\Processos\" & Me.NProcesso.Value ' se não existir cria a subpasta
Me.Pasta.Value = "C:\Processos" & "\" & Me.NProcesso.Value
Me.Pasta.Requery


Para abrir, retire o Else e o End

Dim obj As Object
'By JPaulo Maximo Access
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFileSystem.GetFolder("C:\Processos\")
Set objSubFolders = objFolder.SubFolders
For Each obj In objSubFolders
If InStr(obj.Name, Me.NProcesso.Value) > 0 Then
Shell "explorer.exe """ & obj.Path & "", vbNormalFocus
End If
Next

Rectificação do primeiro código;


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") 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

Nova correcção após testes efectuados;


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

Aqui vai o feedback:

Com o primeiro código tudo trabalha bem, quer no 2000 e no 2003 e perfeito sem erros na aplicação no windows 7. Com a retificação tudo mal de novo pois não deixa criar a pasta, diz que a mesma existe,processo cancelado, etc.

Com esta ultima rectificação ?

Tem de funfar...

É que estou a fazer mil (1000) coisas ao mesmo tempo, por isso não saí à primeira.

Mas esta ultima está 100% testada.

renho estado a testar mestre em 3 máquinas ao mesmo tempo. Uma com o 2000 outra com o 2003 e outra com o 7. Com o primeiro código funciona em todas e no 7 que dava alguns erros de run time (cheguei a instalar o run time do 2003 no 7 e update para o Sp3)agora nem um único erro. Com a retificação, digito o n do processo, clico no botão para criar o processo na pasta e em todos aparece a mensagem (A Pasta já existe, processo cancelado...) no entanto a pasta processo está vazia pois ele nem cria o processo. E isto acontece nos 3 sistemas.

Muito estranho amigo, a instrução correcta é esta;

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 Processos 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

Outro erro que encontrei é onde o amigo tem "Erro", substitua por Title nas mensagens.

Tudo testado, no Access 2003, 2007 e 2010 (Sistemas operativos XP-Profissional e Vista)

Se tiver resolvido, coloque o Resolvido no tópico.

TUDO FUNCIONA NA PERFEIÇÃO E NOS 3 SISTEMAS com este último. Agradeço muito por ter-me tirado deste sufoco e ao Moderador Críquio também.

O meu muito obrigado aos dois.

Valew, se precisar de novo dê um grito.