Proplema com codigo VB 6 Recuperar Backup

Question

No modulo eu uso este codigo:

Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Type SHITEMID
     cb As Long
     abID As Byte
End Type

Type ITEMIDLIST
     mkid As SHITEMID
End Type

Type BROWSEINFO
     hOwner As Long
     pidlRoot As Long
     pszDisplayName As String
     lpszTitle As String
     ulFlags As Long
     lpfn As Long
     lParam As Long
     iImage As Long
End Type

Public Const NOERROR = 0

Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const BIF_DONTGOBELOWDOMAIN = &H2
Public Const BIF_STATUSTEXT = &H4
Public Const BIF_RETURNFSANCESTORS = &H8
Public Const BIF_BROWSEFORCOMPUTER = &H1000
Public Const BIF_BROWSEFORPRINTER = &H2000

 

No Form referente, este codigo

Function CopiarArquivo(Origem As String, Destino As String) As Single

'declara as variaveis
Static Buf As String
Dim BTest As Long
Dim FSize As Long
Dim Chunk As Integer
Dim F1 As Integer
Dim F2 As Integer

Const BUFSIZE = 1024       'define o tamanho do buffer

If Len(Dir(Destino)) Then      'verifica se o arquivo de destino ja existe
   Resposta = MsgBox(Destino + Chr(10) + Chr(10) + "Arquivo já existe. Deseja sobrescrever o arquivo existente ?", vbYesNo + vbQuestion) 'exibe ao usuário uma caixa de mensagem
   If Resposta = vbNo Then 'Se clicou no botão Não
      Exit Function        'sai da rotina
   Else                    'senao
      Kill Destino             'exclui o arquivo existente e continua a executar o codigo

End If
End If
 
On Error GoTo FileCopyError  'se houver erro trata aqui
F1 = FreeFile                'retorna o numero do arquivo disponivel
Open Origem For Binary As F1    'abre o arquivo de destino
F2 = FreeFile                'retorna o numero do arquivo disponivel
Open Destino For Binary As F2    'abre o arquivo de destino
 
FSize = LOF(F1)
BTest = FSize - LOF(F2)

Do
If BTest < BUFSIZE Then
   Chunk = BTest
Else
   Chunk = BUFSIZE
End If
     
Buf = String(Chunk, " ")
Get F1, , Buf
Put F2, , Buf
BTest = FSize - LOF(F2)

pbCopiaArquivos.Value = (100 - Int(100 * BTest / FSize)) 'avanca com a barra de progrossse durante a copia

Loop Until BTest = 0
Close F1 'fecha o fonte
Close F2 'fecha o destino
CopiarArquivo = FSize

MsgBox "Arquivo copiado com sucesso.", vbInformation, "Copia com sucesso"

pbCopiaArquivos.Value = 0 'retorna a barra de progresso para o valor zero
Exit Function      'sai da rotina

FileCopyError:     'trata o erro aqui
MsgBox "Erro durante a copia...!, Tente novamente..." 'exibe mensagem de erro
Close F1           'fecha a fonte
Close F2           'fecha o destino
Exit Function      'sai da rotina

End Function
Public Function ExtraiNome(SpecIn As String) As String
  
Dim i As Integer
Dim saida As String
  
On Error Resume Next 'ignora qualquer erro
  
For i = Len(SpecIn) To 1 Step -1
If Mid(SpecIn, i, 1) = "\" Then
   saida = Mid(SpecIn, i + 1) 'extrai o nome do arquivo do caminho
   Exit For
End If
Next i

ExtraiNome = saida 'retorna o nome do arquivo extraido

End Function

Private Sub Command1_Click()
Dialogo.DialogTitle = "procurar..." 'define o titulo
Dialogo.FileName = "Agendas.mdb"
caminhoOrigem.Text = Dialogo.FileName
Dialogo.ShowOpen

procuraOrigem.Visible = False
procuraDestino.Visible = False
caminhoDestino.Text = App.path & "\Agendas.mdb"
caminhoOrigem.Text = Dialogo.FileName
End Sub

Private Sub Copiar_Click()
On Error Resume Next 'ignora quaisquer erros

If caminhoOrigem.Text = "" Then 'tenha certeza de que a origem foi informado
   MsgBox "Você deve definir o nome e o caminho do arquivo de origem.", vbCritical 'se não informar exibe mensagem
   Exit Sub                                                                       'sai da rotina
End If
If caminhoDestino.Text = "" Then 'tenha certeza de que o arquivo de destino foi informado
   MsgBox "Você deve definir o nome e caminho do arquivo de destino.", vbCritical 'se nao informar exibe mensagem
   Exit Sub                                                                          'sai da rotina
End If

'se tudo estiver correto então copia o arquivo
pbCopiaArquivos.Value = CopiarArquivo(caminhoOrigem.Text, caminhoDestino.Text)
End Sub


Private Sub Form_Load()
procuraOrigem.Visible = False
procuraDestino.Visible = False
caminhoOrigem.Text = "A:\Agendas.mdb"
caminhoDestino.Text = App.path & "\Agendas.mdb"
End Sub

    Private Sub procuraDestino_Click()
    Dim bi As BROWSEINFO 'declara as variaveis
    Dim rtn&
    Dim pidl&
    Dim path As String
    Dim pos As Integer
   
    bi.hOwner = Me.hwnd                 'centraliza o dialogo na tela
    bi.lpszTitle = "Procura destino..." 'define o titulo do texto
    bi.ulFlags = BIF_RETURNONLYFSDIRS   'o tipo de pasta para retornar
    pidl& = SHBrowseForFolder(bi)       'exibe o dialogo
     
    path = Space(512)               'define o tamanho maximo
    T = SHGetPathFromIDList(ByVal pidl&, ByVal path) 'obtem o caminho selecionado
   
    pos% = InStr(path$, Chr$(0))    'extrai o caminho da string
    SpecIn = Left(path$, pos - 1)   'define o caminho extraido
   
    If Right$(SpecIn, 1) = "\" Then 'esteja certo de que a barra "\" esta no fim do caminho
       saida = SpecIn               'se nao estiver , nao faça nada
    Else                            'senao
       saida = SpecIn + "\"         'inclui a barra  "\" no fim do caminho
    End If
   
    caminhoDestino.Text = saida + ExtraiNome(caminhoOrigem.Text) 'monta o nome dos arquivos
    Copiar.Enabled = True
    End Sub
Private Sub caminhoOrigem_Change()

caminhoDestino.Enabled = True 'habilita a caixa de texto
procuraDestino.Enabled = True 'habilita o botão Procurar
'caminhoDestino.SetFocus       'poe o cursor na caixa de texto destino

End Sub
Private Sub procuraOrigem_Click()

Dialogo.DialogTitle = "Procura origem..." 'define o titulo
Dialogo.ShowOpen                          'exibe o dialogo
caminhoOrigem.Text = Dialogo.FileName    'define o texto da caixa de origem

End Sub

Este é o Desenho dos objetos do form

file:///C:/Documents%20and%20Settings/Marco/Meus%20documentos/Minhas%20imagens/Desenho.bmp

MEU PROBLEMA É ESTE PROGRAMA FUNCIONA SOMENTE ISOLADO DE OUTROS FORM

INCLUINDO ELE COM OUTROS FORM UM PROGRAMA COMPLETO FAZER BACKUP E RESTAURAR NÃO FUNCIONA ELE PARA APATIR DESTE SETOR DESTACADO ABAIXO

FAVOR PRECISO DE AJUDA, PARA ESTE PROBLEMA

OBRIGADO

 

 

   "Kill Destino             'exclui o arquivo existente e continua a executar o codigo

End If
End If
 
On Error GoTo FileCopyError  'se houver erro trata aqui
F1 = FreeFile                'retorna o numero do arquivo disponivel
Open Origem For Binary As F1    'abre o arquivo de destino
F2 = FreeFile                'retorna o numero do arquivo disponivel
Open Destino For Binary As F2    'abre o arquivo de destino
 
FSize = LOF(F1)
BTest = FSize - LOF(F2)

Do
If BTest < BUFSIZE Then
   Chunk = BTest
Else
   Chunk = BUFSIZE
End If
     
Buf = String(Chunk, " ")
Get F1, , Buf
Put F2, , Buf
BTest = FSize - LOF(F2)

pbCopiaArquivos.Value = (100 - Int(100 * BTest / FSize)) 'avanca com a barra de progrossse durante a copia

Loop Until BTest = 0
Close F1 'fecha o fonte
Close F2 'fecha o destino
CopiarArquivo = FSize

MsgBox "Arquivo copiado com sucesso.", vbInformation, "Copia com sucesso"

pbCopiaArquivos.Value = 0 'retorna a barra de progresso para o valor zero
Exit Function      'sai da rotina

FileCopyError:     'trata o erro aqui
MsgBox "Erro durante a copia...!, Tente novamente..." 'exibe mensagem de erro
Close F1           'fecha a fonte
Close F2           'fecha o destino
Exit Function      'sai da rotina

End Function
Public Function ExtraiNome(SpecIn As String) As String
  
Dim i As Integer
Dim saida As String
  
On Error Resume Next 'ignora qualquer erro
  
For i = Len(SpecIn) To 1 Step -1
If Mid(SpecIn, i, 1) = "\" Then
   saida = Mid(SpecIn, i + 1) 'extrai o nome do arquivo do caminho
   Exit For
End If
Next i

ExtraiNome = saida 'retorna o nome do arquivo extraido

End Function

Private Sub Command1_Click()
Dialogo.DialogTitle = "procurar..." 'define o titulo
Dialogo.FileName = "Agendas.mdb"
caminhoOrigem.Text = Dialogo.FileName
Dialogo.ShowOpen

procuraOrigem.Visible = False
procuraDestino.Visible = False
caminhoDestino.Text = App.path & "\Agendas.mdb"
caminhoOrigem.Text = Dialogo.FileName
End Sub

Private Sub Copiar_Click()
On Error Resume Next 'ignora quaisquer erros

If caminhoOrigem.Text = "" Then 'tenha certeza de que a origem foi informado
   MsgBox "Você deve definir o nome e o caminho do arquivo de origem.", vbCritical 'se não informar exibe mensagem
   Exit Sub                                                                       'sai da rotina
End If
If caminhoDestino.Text = "" Then 'tenha certeza de que o arquivo de destino foi informado
   MsgBox "Você deve definir o nome e caminho do arquivo de destino.", vbCritical 'se nao informar exibe mensagem
   Exit Sub                                                                          'sai da rotina
End If

'se tudo estiver correto então copia o arquivo
pbCopiaArquivos.Value = CopiarArquivo(caminhoOrigem.Text, caminhoDestino.Text)
End Sub


Private Sub Form_Load()
procuraOrigem.Visible = False
procuraDestino.Visible = False
caminhoOrigem.Text = "A:\Agendas.mdb"
caminhoDestino.Text = App.path & "\Agendas.mdb"
End Sub

    Private Sub procuraDestino_Click()
    Dim bi As BROWSEINFO 'declara as variaveis
    Dim rtn&
    Dim pidl&
    Dim path As String
    Dim pos As Integer
   
    bi.hOwner = Me.hwnd                 'centraliza o dialogo na tela
    bi.lpszTitle = "Procura destino..." 'define o titulo do texto
    bi.ulFlags = BIF_RETURNONLYFSDIRS   'o tipo de pasta para retornar
    pidl& = SHBrowseForFolder(bi)       'exibe o dialogo
     
    path = Space(512)               'define o tamanho maximo
    T = SHGetPathFromIDList(ByVal pidl&, ByVal path) 'obtem o caminho selecionado
   
    pos% = InStr(path$, Chr$(0))    'extrai o caminho da string
    SpecIn = Left(path$, pos - 1)   'define o caminho extraido
   
    If Right$(SpecIn, 1) = "\" Then 'esteja certo de que a barra "\" esta no fim do caminho
       saida = SpecIn               'se nao estiver , nao faça nada
    Else                            'senao
       saida = SpecIn + "\"         'inclui a barra  "\" no fim do caminho
    End If
   
    caminhoDestino.Text = saida + ExtraiNome(caminhoOrigem.Text) 'monta o nome dos arquivos
    Copiar.Enabled = True
    End Sub
Private Sub caminhoOrigem_Change()

caminhoDestino.Enabled = True 'habilita a caixa de texto
procuraDestino.Enabled = True 'habilita o botão Procurar
'caminhoDestino.SetFocus       'poe o cursor na caixa de texto destino

End Sub
Private Sub procuraOrigem_Click()

Dialogo.DialogTitle = "Procura origem..." 'define o titulo
Dialogo.ShowOpen                          'exibe o dialogo
caminhoOrigem.Text = Dialogo.FileName    'define o texto da caixa de origem

End Sub"