FORM LOAD VARRER E IMPORTAR TXT

MARCELOFAZAN 01/07/2010 14:24:54
#346281
Pessoal tenho uma importacao de um TXT feita num command que a pessoa escreve no text o nome do arquivo e importa e uma pasta chama TXT no defa do diretorio onde se encontram varios arquivos TXT
EX .... 00188 , 00222 , 00124 porem ...... o usuario precisa importar um por um
alguem teria um exemplo de como varrer um diretorio e integrar esse arquivos sem necessidade do usuario ter que importar um por um


Esse é codigo a qual tenho num command


Private Sub Command1_Click()
Dim strFileName As String

If Right(txtArquivo.Text, 4) <> [Ô].txt[Ô] Then
MsgBox [Ô]Nome de arquivo inválido.[Ô] & vbLf _
& [Ô]Favor digitar o nome do aquivo com extensão .txt[Ô], vbCritical, [Ô]Sistema de Trenferência[Ô]
Exit Sub
End If

If Dir(App.Path & [Ô]\TXT\[Ô] & txtArquivo.Text, vbArchive) = [Ô][Ô] Then
MsgBox [Ô]Arquivo [ô]TXT[ô] não encontrado![Ô], vbCritical, [Ô]Atenção[Ô]
Exit Sub
End If

strFileName = App.Path & [Ô]\TXT\[Ô] & txtArquivo.Text

Open strFileName For Input As #1

Dim intCod, strPagamento, strPagam, linha, linha2, linha3 As String
Dim p_virgula, u_aspas, s_virgula, t_virgula As Integer

Do Until EOF(1)
linha = strFileName

Line Input #1, linha
p_virgula = InStr(linha, [Ô],[Ô])
linha2 = Mid(linha, p_virgula + 1)
s_virgula = InStr(linha2, [Ô],[Ô])
linha3 = Mid(linha2, s_virgula + 1)
t_virgula = InStr(linha3, [Ô],[Ô])


intCod = LTrim(Mid(linha, 2, p_virgula - 3))
strPagamento = LTrim(Mid(linha2, 2, s_virgula - 3))
strPagam = LTrim(Mid(linha3, 2, t_virgula - 3))

sql = [Ô]UPDATE buscar SET[Ô]
sql = sql & [Ô] pagamento=[ô][Ô] & strPagamento & [Ô][ô],[Ô]
sql = sql & [Ô] pagam=[ô][Ô] & strPagam & [Ô][ô][Ô]
sql = sql & [Ô] Where codigo = [ô][Ô] & intCod & [Ô][ô][Ô]
cn.Execute sql

Loop
Close #1
cn.Close

txtArquivo.Text = App.Path & [Ô]\TXT\[Ô] & txtArquivo.Text
Kill txtArquivo.Text

MsgBox [Ô]Transferência concluida com sucesso[Ô], vbExclamation
txtArquivo.Text = [Ô][Ô]
Unload Me
End Sub


Caso alguem tiver um rascunho com algo parecido e poder colar

Abs
Obriigado
Marcelo Fazan
JCARLOS 01/07/2010 15:22:52
#346298
Exemplo eu não tenho, mas uma dica seria usar o commonDialog, onde o usuário informaria a pasta e a partir daí o programa varreria todos os arquivos contidos nela e processaria um a um automaticamente.
Como usar o commonDialog tem exemplos nos foruns por aí.
Abraços.
MARCELOFAZAN 01/07/2010 15:32:37
#346302
olá Jcarlos

até consigo testar o common dialog

o problema seria como rodar isso no PC do cliente
na instalacao do cliente tem algum pacote ou DLL ou componente a qual precisa instalar ?
acho que precisei e nao consegui fazer funcionar em um PC que nao tem VB instalado
MARCELOFAZAN 02/07/2010 17:54:14
#346415
Pessoal
achei esse codigo o que eu coloco no modulo o que no declarations


Dim Teste As Long
[ô]Teste = ContarArquivos([Ô]c:\windows\[Ô], [Ô]*.dbf[Ô])

[ô]Caso queira contar arquivos específicos mude o *.* pela extensão desejada _
por exemplo *.bmp e assim por diante

[ô]A API abaixo conta todos os arquivo de uma determinada pasta, informada por você

Private Const INVALID_HANDLE_VALUE = -1
Private Const MAX_PATH = 260
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Const FILE_ATTRIBUTE_COMPRESSED = &H800

Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type

Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type

Private Declare Function CreateDirectory Lib [Ô]kernel32[Ô] Alias [Ô]CreateDirectoryA[Ô] (ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
Private Declare Function CopyFile Lib [Ô]kernel32[Ô] Alias [Ô]CopyFileA[Ô] (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Private Declare Function FindFirstFile Lib [Ô]kernel32[Ô] Alias [Ô]FindFirstFileA[Ô] (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib [Ô]kernel32[Ô] Alias [Ô]FindNextFileA[Ô] (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib [Ô]kernel32[Ô] (ByVal hFindFile As Long) As Long
Private Declare Function GetFileAttributes Lib [Ô]kernel32[Ô] Alias [Ô]GetFileAttributesA[Ô] (ByVal lpFileName As String) As Long
Private Declare Function LockWindowUpdate Lib [Ô]user32[Ô] (ByVal hwndLock As Long) As Long

[ô]Para usar a API acima use a seguinte função
Public Function ContarArquivos(Caminho As String, Tipo As String) As Long

Dim WFD As WIN32_FIND_DATA
Dim SA As SECURITY_ATTRIBUTES
Dim r As Long
Dim hFile As Long
Dim bNext As Long
Dim fCount As Long
Dim currFile As Str


e tambem usando esse loop



Private Sub cmd1_Click()
Dim cont As Integer
cont = 0
Do While cont < 5
cont = cont + 1
lbl1.Caption = cont
MsgBox [Ô]Número [Ô] & (cont) & [Ô][Ô]
Loop
End Sub



alguem saberia como juntar essas 2 coisas pra depois juntar a que postei na primeira mensagem a importacao



ou mesmo o que eu pretendo fazer isso ira dar certo

Obrigado
Abs
Marcelo Fazan
Tópico encerrado , respostas não são mais permitidas
Voltar