Link to home
Start Free TrialLog in
Avatar of crystalsoft
crystalsoft

asked on

How to send csv file to the network drive automatically

automatically detect csv files is exist in the folder or not, if exist then
sent it to the mapped network drive and after sending successfully delete original csv file, and go for another csv file...........till all csv file sent success fully,

and every minute function will check csv file exist or not.

and i want all this process automatically

 my approach is for just local drive
not for mapped network drive

Note : all csv file with different different name.
Dim txtdbpath As String  'this is your database file
    Dim txtdbpathcopy As String  'this is your copy path
    Dim intResponse, fs
'   the following double checks, Are you sure?
'    intResponse = MsgBox("Are you sure that you wish to make a copy of your database file now?", vbYesNo + vbDefaultButton1 + vbQuestion, "Crystal")
'    If (intResponse = 6) Then
    Set fs = CreateObject("Scripting.FileSystemObject")
'   txtdbpath = frmMain.cdgDialog.FileName
'   txtdbpath = "D:\Crystal\23456.csv"

    txtdbpath = App.Path & "\" & "23456.csv"
    txtdbpathcopy = "D:\"
    fs.CopyFile txtdbpath, txtdbpathcopy, True
    '''MsgBox "Backup Done Successfully", vbInformation, "Crystal"

Open in new window

Avatar of antonybrahin
antonybrahin

The below code will get all the files in your folder

u can copy it to your map drive exactly same as local drive.

fs.deletefile will do the deletion for you.
Dim oFileSystem As New FileSystemObject
    Dim oFolder As Folder
    Dim oCurrentFile As File
    Dim oFileColl As Files

    Set oFolder = oFileSystem.GetFolder(“C:\Files”)
    Set oFileColl = oFolder.Files

    If oFileColl.Count > 0 Then
        With lstFiles
            For Each oCurrentFile In oFileColl
                .AddItem oCurrentFile.Name 'add item
            Next
            .ListIndex = 0
        End With
    End If

    Set oFileSystem = Nothing
    Set oFolder = Nothing
    Set oFileColl = Nothing
    Set oCurrentFile = Nothing

Open in new window

Avatar of crystalsoft

ASKER

sir, not all the files,
 i want to send only .CSV files
oCurrentFile.Type will give you the filetype.. so just check it before accessing the file.
You can use a tool called robocopy, which is part of the Windows Resource Tool Kit : http://www.microsoft.com/downloads/en/details.aspx?familyid=9d467a69-57ff-4ae7-96ee-b18c4790cffd&displaylang=en

A command like ...

ROBOCOPY C:\Files \\Server\Share\Files *.csv /MOV /MOT:1


This will sit there just waiting for new files.

If you want to run this as a job or scheduled task every minute, rather than having robocopy open all the time, then you can create a scheduled task to run ...

ROBOCOPY C:\Files \\Server\Share\Files *.csv /MOV

every minute.

You can use a command line tool ...

schtasks /create /sc MINUTE /tn MoveCSVs /TR "C:\PROGRA~1\WI8DE7~1\Tools\robocopy.exe C:\Files \\Server\Share *.csv /mov"

The short name may be different on your setup.

o.k. first of all do you want to do  this in your access application?
or in vb/vbscript?
 for access it's something like:

Dim txtdbpath As String  'this is your database file
    Dim txtdbpathcopy As String  'this is your copy path
    Dim intResponse, fs
    Set fs = CreateObject("Scripting.FileSystemObject")
    txtdbpath = CurrentProject.Path & "\" & "*.csv"
    txtdbpathcopy = "D:\"
    On Error Resume Next
    fs.CopyFile txtdbpath, txtdbpathcopy, True
    If Err = 0 Then
    fs.DeleteFile txtdbpath
    End If
    Set fs = Nothing




Thanks Surone1
in  VB6

following code is working fine from my vb6.0 application

Dim txtdbpath As String  'this is your database file
    Dim txtdbpathcopy As String  'this is your copy path
    Dim intResponse, fs
'   the following double checks, Are you sure?
'    intResponse = MsgBox("Are you sure that you wish to make a copy of your database file now?", vbYesNo + vbDefaultButton1 + vbQuestion, "Crystal")
'    If (intResponse = 6) Then
    Set fs = CreateObject("Scripting.FileSystemObject")
'   txtdbpath = frmMain.cdgDialog.FileName
'   txtdbpath = "D:\Crystal\23456.csv"

    txtdbpath = App.Path & "\" & "23456.csv"
    txtdbpathcopy = "D:\"
    fs.CopyFile txtdbpath, txtdbpathcopy, True
    '''MsgBox "Backup Done Successfully", vbInformation, "Crystal"

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of Surone1
Surone1
Flag of Suriname image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Surone1:
Thanks i will put your code on Timer event

another thing is : -
I am using your suggested code from your earlier post (Type Mismatch Error)
https://www.experts-exchange.com/questions/26461408/Type-Mismatch-Error.html
09/14/10 02:11 PM, ID: 33670085

When i am adding more fields
its split name like ( Tom Cruise ) its split into two field and
On insert command its giving me Run Time Error that Number of Query Values and Destination Fields aren't the same,
and highlighted on following line
        con.Execute "insert into Bilty_Detail (BiltyNo,Mode,BDate,TruckNo,Code,Consignor,Consignee,From_City,To) values (" & valuelist & ")"

Problem is on following line
        props = Split(line, " ")     < ------- this line split name also and this is the problem thats why i am getting error

Const adOpenStatic = 3
Const adLockOptimistic = 3
Const ForReading = 1
Const MDB_FILE = "D:\Crystal\Auto_Trans\Transport.mdb"
Const TABLE_NAME = "Bilty_Detail"
Const TABLE_COLUMNS = "BiltyNo,Mode,BDate,TruckNo,Code,Consignor,Consignee,From_City,To"
''''Following fields need to add in TABLE_COLUMNS
''',From_City,To,Article,Description,Weight,Rate,ToPay,Paid,Pymt_mode,CR,HC,AOC,BC,Others,Total,Pvt_Mark,Declaration_val,Delivery_at,Narration,GroupName,Service_Tex,User_Name,Chg_Weight,TotToPay,TotPaid,Art_Type,Rate_Type,CNorTinNo,CNeeTinNo,STaxPayBy,FOV,Door_Delv,Invo_No,Status_Rec,CnorPNo,CneePno
Const CSV_SEARCH_PATH = "D:\Crystal\Auto_Trans"

Dim fso As New FileSystemObject
Dim objConnection As New ADODB.Connection
Dim objRecordSet As New ADODB.Recordset
Dim drive, objWMIService, path, line, objFile, oFile, i, props, colFiles, columns

Set objRecordSet = CreateObject("ADODB.Recordset")

objRecordSet.Open "SELECT * FROM " & TABLE_NAME, _
    con, adOpenStatic, adLockOptimistic

Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")

drive = Split(CSV_SEARCH_PATH, "\")(0)
path = "\\" & Replace(Split(CSV_SEARCH_PATH, drive + "\")(1), "\", "\\") & "\\"

Set colFiles = objWMIService.ExecQuery("Select * from CIM_DataFile where Drive='" + drive + "' and path = '" + path + "' and extension = 'csv'")

For Each oFile In colFiles
    
    Set objFile = fso.OpenTextFile(oFile.Name, ForReading)
    Dim valuelist
    For Each line In Split(objFile.ReadAll, vbNewLine)
        objRecordSet.AddNew
        columns = Split(TABLE_COLUMNS, ",")
        
        ''''''''''''''''''''''''''''''''''''''
        props = Split(line, " ")
For i = 0 To UBound(props)
If Not IsNull(props(i)) And props(i) <> "" Then
If valuelist = "" Then
valuelist = valuelist & "'" & props(i) & "'"
Else
valuelist = valuelist & ",'" & props(i) & "'"
End If
End If
Next i
        
If valuelist <> "" Then
'objConnection.Execute "insert into  Bilty_Detail (BiltyNo,Mode,BDate,from_City,To) values (" & valuelist & ")"
        con.Execute "insert into Bilty_Detail (BiltyNo,Mode,BDate,TruckNo,Code,Consignor,Consignee,From_City,To) values (" & valuelist & ")"
        '''',From_City,To,Article,Description,Weight,Rate,ToPay,Paid,Pymt_mode,CR,HC,AOC,BC,Others,Total,Pvt_Mark,Declaration_val,Delivery_at,Narration,GroupName,Service_Tex,User_Name,Chg_Weight,TotToPay,TotPaid,Art_Type,Rate_Type,CNorTinNo,CNeeTinNo,STaxPayBy,FOV,Door_Delv,Invo_No,Status_Rec,CnorPNo,CneePno

End If
        Next
            Next

Open in new window

284750.csv
If you simply want to move all CSV's to a different location -- reverting back to your original code, something like this doesn't work for you?
(Code below moves all CSV's to the Archive folder)

The only thing you'd need to do is set a task scheduler job to run the code every X minutes.

http://www.activexperts.com/activmonitor/windowsmanagement/adminscripts/filesfolders/files/#MoveFiles.htm
On Error Resume Next
Dim fso, folder, files, NewsFile,sFolder

Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.MoveFile "C:\oldLocation\*.csv" , "D:\newLocation\"

Open in new window

i think according to :
https://www.experts-exchange.com/M_5138128.html
my answer at:
https://www.experts-exchange.com/M_4578008.html
provides the solution for this question..
sorry for that slipup..
#33684107
"Surone1:
Thanks i will put your code on Timer event"

and
#33683836
would be the answer
Avatar of Dirk Haest
This question has been classified as abandoned and is being closed as part of the Cleanup Program.  See my comment at the end of the question for more details.