Olá Oscar,

 

Se entendi, isto deve funcionar:

 

Private Sub Command1_Click()
  On Error GoTo Erro
  Dim Origem, Destino, Linha As String
  Dim i As Integer
  CommonDialog1.Filter = "Todos os Arqivos (*.*)|*.*|Arquivos Texto (*.txt)|*.Txt"
  CommonDialog1.FilterIndex = 2
  CommonDialog1.ShowOpen
  Origem = CommonDialog1.FileName
  Open Origem For Input As #1
  Screen.MousePointer = vbHourglass
  i = 0
  Do While Not EOF(1)
    Line Input #1, Linha
    If Mid(Linha, 1, 6) = "Create" Then
      i = i + 1
      Destino = "C:TEMPProc_" & CStr(i) & ".TXT"
      If i <> 1 Then
        Close #2
      End If
      Open Destino For Output As #2
    End If
    Print #2, Linha
  Loop
  Close #1
  Close #2
  Screen.MousePointer = vbDefault
  MsgBox "A divisão foi efetuada com sucesso !", vbOKOnly, "Atenção"
  Exit Sub
Erro:
  Screen.MousePointer = vbDefault
  MsgBox "Ocorreu o erro nº " & Err.Number & vbCr & vbCr & Err.Description, vbOKOnly, "Atenção"
  Err.Clear
End Sub

Jayme

muito obrigado cara, mass já cosegi resolver o problema, era pra dividir uma proc em várias procs, usei este código, mesmo assim muit obrigado.

 

Option Explicit
'declaro as vars aqui
Dim Conex               As New ADODB.Connection
Dim Rs                  As New ADODB.Recordset
Dim Rs2                 As New ADODB.Recordset

Dim Fso                 As New FileSystemObject

Dim Arqtxt, Pasta, x

Private Sub Command1_Click()
'se o caminho for "" então eu mando a pasta ser digitada
If txtcaminho = "" Then
    MsgBox "Digite a Pasta"
    txtcaminho.SetFocus
End If
'chama a Sub Criar a pasta
Call CriarPasta

'caso não haja a  eu faço com que ela exista no caminho, para a gravação dos arquivos
If Right(txtcaminho, 1) <> "" Then
    Pasta = txtcaminho & ""
End If

'a cada vez q o evento é executado a lista é atualizada
File1.Path = Pasta: DoEvents

'estou abrindo conexão com o banco
Rs.Open "Select name from SysObjects Where xtype = 'P'", Conex, 3, 3

'contador
x = 0

'loop
While Not Rs.EOF
    '
    x = x + 1
    'mostra o número de arquivos que eu tenho
    Command1.Caption = "Qtd de Arquivos: " & x: DoEvents
    'cria os arquivos SQL, como eu não sei o nome do campo eu uso Rs.Fields(0)
    Fso.CreateTextFile (Pasta & Rs.Fields(0) & ".Sql")
   
    Set Arqtxt = Fso.OpenTextFile(Pasta & Rs.Fields(0) & ".Sql", ForWriting, True)
    'uso sp_helptext , para chamar todas as procedures
    Rs2.Open "sp_helptext " & Rs.Fields(0) & "", Conex, 3, 3
       
        'loop para escrever os arquivos
        While Not Rs2.EOF
            Arqtxt.Write Trim(Rs2.Fields(0))
        Rs2.MoveNext
        Wend
       
        File1.Path = Pasta: DoEvents
        File1.Refresh
    'fecho as conexões
    Rs2.Close
    Arqtxt.Close
   
Rs.MoveNext
Wend

File1.Path = Pasta
File1.Refresh

End Sub

Private Sub Command2_Click()
    End
End Sub

Private Sub Form_Load()
'ao carregar o form eu abro uma conexão com o banco
Conex.Open "Driver={SQL Server};" & _
                   "Server=servidor;" & _
                   "Database=banco;" & _
                   "Uid=usuário;" & _
                   "Pwd=senha"
End Sub
Sub CriarPasta()
'caso não haja a pasta a pasta é criada e ele coninua normalmente
On Error Resume Next
    Fso.CreateFolder txtcaminho
End Sub