[Resolvido]Erro no código criar pasta

Peguei num código aqui do forum do JPaulo para a criação de pastas e adaptei ao meu código, ficando assim,

Código:


Private Sub Rótulo50_Click()
Dim f    As Object
Dim varFile As Variant
Dim db As Database
Dim tb As Recordset
Dim name As String
Dim fso As Object
Dim caminho As String

Set f = Application.FileDialog(3)

        f.AllowMultiSelect = True
        f.Filters.Clear
        f.Filters.Add "Ficheiros PDF", "*.pdf"
        f.Filters.Add "Ficheiros Excel", "*.xlsx"
        f.Filters.Add "Ficheiros Excel 2003", "*.xls"
        f.Filters.Add "Ficheiros Word", "*.docx"
        f.Filters.Add "Ficheiros Word 2003", "*.doc"
        f.Filters.Add "All Files", "*.*"
 
 caminho = CurrentProject.Path & " \ Files \ "
 Set db = CurrentDb
 Set tb = db.OpenRecordset("AnexosAvarias")
 Set fso = CreateObject("caminho" & Me.Incidente.Value)
 
 If f.Show = True Then
 
        For Each varFile In f.SelectedItems
       
            name = Mid(varFile, 1 + InStrRev(varFile, "\"))
           
            If fso.FolderExists("caminho" & Me.Incidente.Value) Then
           
                If DCount("*", "AnexosAvarias", "Nome='" & name & "'") > 0 Then
           
                            MsgBox "O Ficheiro já existe!", vbExclamation
           
                                Else
           
                                    FileCopy varFile, "caminho" & Me.Incidente.Value & name
                                    tb.AddNew
                                    tb!Nome = name
                                    tb!Incidente = Me.Incidente.Value
                                    tb.Update
           
                        End If
               
                    Else
                       
                        MkDir "caminho" & Me.Incidente.Value
                       
                        If DCount("*", "AnexosAvarias", "Nome='" & name & "'") > 0 Then
           
                            MsgBox "O Ficheiro já existe!", vbExclamation
           
                                Else
           
                                    FileCopy varFile, "caminho" & Me.Incidente.Value & name
                                    tb.AddNew
                                    tb!Nome = name
                                    tb!Incidente = Me.Incidente.Value
                                    tb.Update
           
                        End If
              End If
           
        Next
       
            tb.Close
            Set db = Nothing
End If
Me.Refresh
End Sub

No entanto dá o seguinte erro,

ActiveX component can´t create object

na linha

Set fso = CreateObject("caminho" & Me.Incidente.Value)

Olá,

Activei a referência Microsoft Office 12.0 Object Library e continua a dar o mesmo erro na mesma linha.
Tenho também activada a referência Microsoft Scripting Runtime..

Criei a variável "caminho" como string, o seguinte código é possível?

caminho = CurrentProject.Path & " \ Files \ "

Porque na linha que dá erro está lá a variável caminho

Set fso = CreateObject("caminho" & Me.Incidente.Value)

Ricardo

Na realidade é:

Microsoft ActiveX Data Objects xx.x Libray

Onde o "xx.x é a versão existente no teu computador.

Caso também não dê certo, volte ao post do JPaulo e verifique se ele diz algo sobre a referência.
De preferência coloque o link do post dele aqui.

Abraços

Olá,

Activei a referência Microsoft ActiveX Data Object 2.8 Library (tenho 2.1 até 2. continua a dar o mesmo erro

O tópico de onde tirei o código é o seguinte,

http://maximoaccess.forumeiros.com/t443-resolvido-criar-pasta-com-seleccao?highlight=criar+pasta

o código é este,

http://dl.dropbox.com/u/771097/Vieira.txt

E deixo a minha BD teste para verem,

https://www.dropbox.com/s/ax8xtl9sa9xi01z/BDFile.zip

Meu amigo Ricardo

Creio que irá funcionar se você trocar essa linha

Set fso = CreateObject("caminho" & Me.Incidente.Value)

Por essa:
Set fso = CreateObject("Scripting.FileSystemObject")

Que por sinal está no código do JPaulo.

Abraços

Olá,

Tens razão, não sei como fui criar aquela linha de código.
O erro de desapareceu mas fiquei com outro, "Path not found". Acho que tem a ver com a forma como eu escrevo o caminho utilizando CurrentProject.Path & " \ Files \ " & Me.Incidente.Value .

Vai mais uma ajuda?

Aqui fica a BD (actual),

https://www.dropbox.com/s/ax8xtl9sa9xi01z/BDFile.zip

Veja:

Você está usando o caminho das pasta e colocando no final o nome de um controle ao invés de colocar o nome do arquivo:

CurrentProject.Path & " \ Files \ " & NomedoArquivo.extensão

Abraços

Mas eu quero criar a pasta com o código do registo actual, por exemplo,

CurrentProject.Path\Files\3768061\

E só depois copiar o arquivo para esta localização.

Entendi

Vou estudar teu código, chegando a uma solução eu retorno.

Obrigado pela disponibilidade.

Ricardo

Desculpe a demora, coisas a fazer aqui.

Veja teu código:

CurrentProject.Path & " \ Files \ " & Me.Incidente.Value

O correto é:
CurrentProject.Path & "\Files\" & Me.Incidente.Value

Ou seja, não deve haver espaços em uma string, por isso o erro.

Verifique todo o teu código mais adiante e retire esses espaços.

Editando:

Conserte essa linha também:

FileCopy varFile, CurrentProject.Path & "\Files\" & Me.Incidente & "\" & name


Abraços

Olá,

Corrigi essas linhas e esse erro desapareceu, a pasta é criada e o ficheiro é copiado para essa localização. No entanto se eu quiser adicionar um outro ficheiro a esse mesmo registo dá erro, uma vez que o teste para verificar se a pasta existe ou não parece que não está a funcionar, ele passa automaticamente para o "Else" principal e tenta criar novamente a pasta.

Obrigado pela paciência.

Ricardo

Substitua a linha do teu aplicativo por essa:

If fso.FolderExists(CurrentProject.Path & "\Files\" & Me.Incidente) Then


CurrentProject.Path não leva aspas.

Muito obrigado, resolveu o meu problema.
Obrigado pela disponibilidade e paciência.

Ótimo Ricardo

Obrigado pelo retorno.

Boa sorte!