ACCESS VBA Localizando pastas

[ClaudioZana]

Bom dia Pessoal.

 

Preciso de ajuda para localizar uma pasta no servidor dentro de um diretório.

 

Ex:

Tenho uma "caixa de texto" em meu formulário, nisso escrevo nela 10141519 e na frente quero que apareça o link da pasta, exemplo:

 

c:\minhapasta\10141519*\

 

O problema que estou tendo é que para pastas o asterisco não funciona como deveria. Se tivesse um arquivo chamado 10141519 computador.txt

seria extremamente fácil, só seria colocar o comando dir(c:\mistapasta\10141519*.txt) que localizaria o link correto. (Para pastas o * não funciona )

 

Alguma dica?

 

Atenciosamente

Claudio Zana

 

 

[ClaudioZana]

Dim nome_pasta As StringDim pasta_data_fim As StringDim pasta_oportunidade As StringDim pasta_temporario As StringDim pasta_proposta As StringDim pasta_pedido As StringSub pastas()nome_pasta = Me.proposta & " CLIENTE " & Replace(Me.Localidade, "/", "-") & " " & Me.Oportunidadepasta_data_fim = (CurrentProject.Path & "\" & Replace(Me.Data_Fim, "/", "_") & "\")pasta_oportunidade = pasta_data_fim & "\" & nome_pastapasta_temporario = CurrentProject.Path & "\temporario\" & nome_pastapasta_proposta = "D:\Cotações SAP\"If Len(Me.proposta & Me.Oportunidade) = 18 Then    pasta_data_fim = pasta_proposta    pasta_oportunidade = pasta_data_fim & nome_pastaEnd IfEnd SubSub Data_Fim_Dirty(cancel As Integer)Call pastasIf Len(Dir(pasta_oportunidade, vbDirectory)) > 0 ThenName pasta_oportunidade As pasta_temporarioIf Len(Dir(CurrentProject.Path & "\" & Replace(Me.Data_Fim, "/", "_") & "\" & nome_pasta)) > 0 ThenName CurrentProject.Path & "\" & Replace(Me.Data_Fim, "/", "_") & "\" & nome_pasta As pasta_temporarioEnd IfEnd IfEnd SubSub data_fim_exit(cancel As Integer)Call pastasIf Len(Dir(pasta_temporario, vbDirectory)) = 0 Then    If Len(Me.Oportunidade & Me.Data_Fim & Me.Hora_Fim) = 28 Then        If Len(Dir(pasta_data_fim, vbDirectory)) = 0 Then            MkDir (pasta_data_fim)            If Len(Dir(pasta_oportunidade, vbDirectory)) = 0 Then                MkDir (pasta_oportunidade)            End If        Else            If Len(Dir(pasta_oportunidade, vbDirectory)) = 0 Then                MkDir (pasta_oportunidade)            End If        End If    End IfElse    If Len(Dir(pasta_data_fim, vbDirectory)) = 0 Then        MkDir (pasta_data_fim)    End IfName pasta_temporario As pasta_oportunidadeEnd IfEnd SubSub atalho_oportunidade_click()Call pastaspropost = Dir(pasta_proposta & Me.proposta & "*", vbDirectory)If Len(Dir(pasta_proposta & propost, vbDirectory)) > 0 ThenApplication.FollowHyperlink pasta_proposta & propostElseApplication.FollowHyperlink pasta_oportunidadeEnd IfEnd SubSub proposta_Dirty(cancel As Integer)Call pastasIf Len(Dir(pasta_oportunidade, vbDirectory)) > 0 ThenName pasta_oportunidade As pasta_temporarioEnd IfIf Len(Dir(CurrentProject.Path & "\" & Replace(Me.Data_Fim, "/", "_") & "\" & nome_pasta)) > 0 ThenName CurrentProject.Path & "\" & Replace(Me.Data_Fim, "/", "_") & "\" & nome_pasta As pasta_temporarioEnd IfEnd SubSub proposta_exit(cancel As Integer)Call pastasIf Len(Dir(pasta_temporario, vbDirectory)) = 0 Then       If Len(Me.Oportunidade & Me.Data_Fim & Me.Hora_Fim) = 28 Then    If Len(Dir(pasta_data_fim, vbDirectory)) = 0 Then        MkDir (pasta_data_fim)        If Len(Dir(pasta_oportunidade, vbDirectory)) = 0 Then            MkDir (pasta_oportunidade)        Else        End If    Else    If Len(Dir(pasta_oportunidade, vbDirectory)) = 0 Then        MkDir (pasta_oportunidade)    Else    End If    End If    End IfElseIf Len(Dir(pasta_data_fim, vbDirectory)) = 0 ThenMkDir (pasta_data_fim)ElseEnd IfName pasta_temporario As pasta_oportunidadeEnd IfEnd Sub

O script a cima tem a ideia de criar as pastas e caso você for preenchendo mais campos ele vai atualizando o nome das pastas e realocando em pastas diferentes... . Estou tentando automatizar meu trabalho e com isso aprendendo VBA.

[ClaudioZana]

Dim nome_pasta As StringDim pasta_data_fim As StringDim pasta_oportunidade As StringDim pasta_temporario As StringDim pasta_proposta As StringDim pasta_pedido As StringDim pasta_mes As StringDim mes As StringDim pasta_ano As StringDim ANO As StringPublic pasta_provisoria As StringSub pastas()nome_pasta = Me.proposta & " Cliente " & Replace(Me.Localidade, "/", "-") & " " & Me.Oportunidademes = Mid(Me.Data_Fim, 4, 2)ANO = Mid(Me.Data_Fim, 7, 4)pasta_ano = CurrentProject.Path & "\" & ANO & "\"pasta_mes = pasta_ano & mes & "\"pasta_data_fim = (pasta_mes & Replace(Me.Data_Fim, "/", "_") & "\")pasta_oportunidade = pasta_data_fim & "\" & nome_pastapasta_temporario = CurrentProject.Path & "\temporario\" & nome_pastapasta_proposta = "o:\Engenharia\CotaçõesIf Len(Me.proposta & Me.Oportunidade) = 18 Then    pasta_data_fim = pasta_proposta    pasta_oportunidade = pasta_data_fim & nome_pastaEnd IfEnd SubSub Data_Fim_Dirty(cancel As Integer)Call pastaspasta_temporario = pasta_provisoriaIf Len(Dir(pasta_oportunidade, vbDirectory)) > 0 ThenName pasta_oportunidade As pasta_temporarioIf Len(Dir(CurrentProject.Path & "\" & Replace(Me.Data_Fim, "/", "_") & "\" & nome_pasta)) > 0 ThenName CurrentProject.Path & "\" & Replace(Me.Data_Fim, "/", "_") & "\" & nome_pasta As pasta_temporarioEnd IfEnd IfEnd SubSub data_fim_exit(cancel As Integer)Call pastaspasta_provisoria = pasta_temporarioIf Len(Dir(pasta_temporario, vbDirectory)) = 0 ThenMsgBox pasta_temporario    If Len(Me.Oportunidade & Me.Data_Fim & Me.Hora_Fim) = 28 Then        If Len(Dir(pasta_data_fim, vbDirectory)) = 0 Then            If Len(Dir(pasta_ano, vbDirectory)) = 0 Then            MkDir pasta_ano            End If            If Len(Dir(pasta_mes, vbDirectory)) = 0 Then            MkDir (pasta_mes)            End If            MkDir (pasta_data_fim)            If Len(Dir(pasta_oportunidade, vbDirectory)) = 0 Then               MkDir pasta_oportunidade               MkDir pasta_oportunidade & "\1. E-mails\"                                          End If        Else            If Len(Dir(pasta_temporario, vbDirectory)) > 0 Then                Name pasta_temporario As pasta_oportunidade                End If            If Len(Dir(pasta_oportunidade, vbDirectory)) = 0 Then               MkDir pasta_oportunidade               MkDir pasta_oportunidade & "\1. E-mails\"                         End If        End If    End IfElse   If Len(Dir(pasta_data_fim, vbDirectory)) = 0 Then            If Len(Dir(pasta_ano, vbDirectory)) = 0 Then            MkDir pasta_ano            End If            If Len(Dir(pasta_mes, vbDirectory)) = 0 Then            MkDir (pasta_mes)            End If            MkDir (pasta_data_fim)    End IfName pasta_temporario As pasta_oportunidadeEnd IfEnd Sub 

Segue melhoria...