om om om......Kok di Filenya ada Tombol P R O S E S, berarti harus make makro donk oomm........
kodingannya kayak gini nih oom ......
' --------------------------------------------- *
' Created By: puthut_vai@ yahoo.com
' On : 24 Oktober 2009 || Jakarta
' Nama Modul : ModSolusi
' --------------------------------------------- *
Option Explicit
Sub SolusiBuatSiOm()
Application.ScreenUpdating = False
Dim wShitMaster As Worksheet
Dim txttext As String
Set wShitMaster = Worksheets("SolusiSiOOm") ' Set Master
Dim r As Long
r = 2
Do While wShitMaster.Cells(r, 2) <> ""
txttext = wShitMaster.Cells(r, 2)
wShitMaster.Cells(r, 3) = PencarianFileTXT(wShitMaster.Cells(r, 2))
r = r + 1
Loop
Call
Rekapdata
wShitMaster.Activate
Columns("A:I").EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub
Private Sub Rekapdata()
Dim txtValidasi As String
Dim vCountBelum, vCountSudah As Long
Dim x As Long
x = 2
vCountBelum = 2
vCountSudah = 2
With ActiveSheet
.Cells(vCountBelum - 1, 5) = "Rekap Belum Dikirim"
.Cells(vCountSudah - 1, 8) = "Rekap Sudah Dikirim"
Do While .Cells(x, 2) <> ""
txtValidasi = .Cells(x, 3)
If txtValidasi = "Belum
Kirim" Then
.Cells(vCountBelum, 5) = vCountBelum - 1
.Cells(vCountBelum, 6) = .Cells(x, 2)
vCountBelum = vCountBelum + 1
ElseIf txtValidasi = "Sudah Kirim" Then
.Cells(vCountSudah, 8) = vCountSudah - 1
.Cells(vCountSudah, 9) = .Cells(x, 2)
vCountSudah = vCountSudah + 1
End If
x = x + 1
Loop
End With
End Sub
' --------------------------------------------- *
' Created By: puthut_vai@ yahoo.com
' On
: 24 Oktober 2009 || Jakarta
' Nama Fungsi : PencarianFileTXT
' --------------------------------------------- *
Public Function PencarianFileTXT(sNamaFile As String) As String
Dim PencarianFile As FileSearch
Dim FilePath As String, NamaFile As String
Dim i As Integer, foundFileCount As Integer
' Spesifikasi
FilePath = ThisWorkbook.Path
NamaFile = sNamaFile & ".txt"
Set PencarianFile = Application.FileSearch
With PencarianFile
.NewSearch
.LookIn = FilePath
.Filename = NamaFile
.SearchSubFolders = False
.Execute
' Set Pencarian 0 = Tidak ditemukan
foundFileCount = .FoundFiles.Count
End With
' Validasi Pencarian
If foundFileCount = 0 Then
PencarianFileTXT = "Belum Kirim"
Else
PencarianFileTXT = "Sudah Kirim"
End
If
End Function
File Terlampir
--- On Fri, 10/23/09, Hendro Supardi <[email protected]> wrote:
From: Hendro Supardi <[email protected]>
Subject: [belajar-excel] Membuat Rekap Laporan
To: [email protected]
Date: Friday, October 23, 2009, 2:43 PM
Bapak/Ibu,
Mohon bantuannya ya, saya sedang membuat setiap hari menerima laporan dalam
bentuk file txt, bagaimana caranya membuat rekap laporan tersebut yang ada
dalam folder Data Laporan. Bila laporan tersebut sudah ada dalam folder
tersebut, maka pada kolom C tertulis "Sudah Kirim" dan bila file tidak ada
dalam folder tersebut, kolom D tertulis "Belum Kirim" (data terlampir).
Terima kasih atas bantuannya.
Wassalam,
Hendro
Buat sendiri desain eksklusif Messenger Pingbox Anda sekarang!
Membuat tempat chat pribadi di blog Anda sekarang sangatlah mudah
Data Laporan Plus VBA.ra_
Description: Binary data
