Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Module needed to copy file 1

Status
Not open for further replies.

nayfeh

Programmer
Mar 13, 2002
163
CA
Hi,

I have a function already setup the creates a text file of orders. I need a function that copies this file to a particluar location on our server if it doesn't already exist, and if it does, then it appends to the existing file.

Will this be hard to do? I can use a form to do this, I just am not familiar with the coding required. The function I use to create the text file is below if you need it.

Thanks so much in advance.
TN

-------------------------
strSql = "SELECT * FROM TBLHEADERS WHERE UPLOADED = FALSE ORDER BY DeliveryDate"
Set db = CurrentDb
Set rs = db.OpenRecordset(strSql, dbOpenDynaset)
rs.MoveFirst
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile(strTextName, ForWriting, 0)
While Not rs.EOF
strBuffer = rs!Imported
Mid(strBuffer, 1, 1) = "0"
strValue = Format(Str(rs!RouteNbr), "0000")
Mid(strBuffer, 2, 4) = strValue
strValue = Format(Str(rs!CustomerNbr), "000000000")
Mid(strBuffer, 6, 9) = strValue
strValue = Format(rs!DeliveryDate, "mmddyyyy")
Mid(strBuffer, 15, 8) = strValue
strValue = Format(Str(rs!TotQuantity), "000000000")
Mid(strBuffer, 23, 9) = strValue
f.WriteLine (strBuffer)
strSql2 = "SELECT * FROM tblOrders WHERE UPLOADED = FALSE AND FKPKEY = " _
& rs!pkey
rs.Edit
rs!Uploaded = True
rs.Update
Set rs1 = db.OpenRecordset(strSql2, dbOpenDynaset)
If rs1.RecordCount > 0 Then
rs1.MoveFirst
While Not rs1.EOF
strBuffer = rs1!Imported
Mid(strBuffer, 1, 1) = "1"
strValue = Format(Str(rs1!ProductNbr), "000000000")
Mid(strBuffer, 2, 9) = strValue
strValue = Format(Str(rs1!Quantity), "000000")
Mid(strBuffer, 18, 6) = strValue
f.WriteLine (strBuffer)
rs1.Edit
rs1!Uploaded = True
rs1.Update
rs1.MoveNext
Wend
rs1.Close
End If
rs.MoveNext
Wend


GoTo ExitUpload
 
To append to a file (or create a blank file):
[tt]
Sub AppendToFile(SourceName As String, DestName As String)
Dim SourceHandle As Integer
SourceHandle = FreeFile
Open SourceName For Input As #SourceHandle

Dim DestHandle As Integer
DestHandle = FreeFile
Open DestName For Append As #DestHandle

Do While Not EOF(SourceHandle)
Dim SomeText As String
Line Input #SourceHandle, SomeText
Print #DestHandle, SomeText
Loop

Close #SourceHandle
Close #DestHandle
End Sub
[/tt]

to tell if a file exists:
[tt]
if Dir(ThePath) <> &quot;&quot; then
' the file exists
endif
[/tt]

although you won't need this for the above append routine
 
Hi Beetee,

Thanks for your reply. I am very new to vba so I don't quite understand your code. Can I place this code within my form as a command button?

The fields #SourceHandle, #DestHandle, SomeText. What values do I place for these fields?

If you can provide further info, it would be greatly appreciated.

The name for my file is ord_data.dat.
The source directory is: \\ndhsrv2\ndhmma1The detsination directory is: \\ndhmfg1
Thanks again!
TN
 
All you should need to do is:
1) Create a module, and paste the entire AppendToFile subroutine into the module. Compile the code, then save the module as AppendToFileModule.

2) Create an event procedure for your command button. Here we'll assume the Command Button is named 'AppendDataButton'

3) Within the event procedure, add this:

[tt]
Private Sub AppendDataButton_Click()
AppendToFile \\ndhsrv2\ndhmma1\ord_data.dat \\ndhmfg1\ord_data.dat
end sub
[/tt]

If any of this doesn't seem to work, let me know.

BACK UP ANY CRITICAL DATA FIRST!!!

 
Hi BeeTee,

I'm getting a syntax error when I click the command button.

Do I have to use brackets or quotations? I tried testing it from a file in my local C drive copied to the same destination folder. Couldn't get it to run.

Thanks,
TN
 
Sorry BeeTee...I overcome that problem.

Thanks so much. Looks like it's working great!!

Thanks,
TN
 
I apologize for leaving the quotes off the names (that will teach me to not at least paste it into a new module window first). Glad to hear you got it working!

Bill
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top