View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Mark Thorpe Mark Thorpe is offline
external usenet poster
 
Posts: 11
Default FileCopy creates two files

Hi Tony -

I'm not sure why the copy is being created, but it would be helpful if you
could step through the code and determine the exact line of code which
spawns the duplicate. Does the copy first appear after you execute the
FileCopy line? When you open targetfile? Somewhere else? If you know this,
you should be able to write a much simpler subroutine which duplicates the
problem. This will make it easier to diagnose.

Hope this helps.



"Tony" wrote in message
om...
Hello all. I have a question that I hope someone can help pinpoint
what's happening. I created a worksheet with a single push button to
move lots of data from specific text and spreadsheet files into a
single common file. The single file is based on a xls template. The
worksheet uses three columns (starting at A2 - C2 Row 1 is the
asthetic header). The user supplies the specific filenames for the
macro to use to gain its data: for example,

A B C
1 Container HSG NDA
2 S123456 040304 SRNDA356

The macro will create and open a spreadsheet called S123456.xls in a
specific directory on the users hard drive (a FileCopy from the
template) and then open the xls spreadsheet called 040304.xls,
populate the S123456.xls with specific data, close the 040304.xls,
then move to the SRNDA356 text file and do the same thing. It works
very well, except that the macro is creating a duplicate of the
template only to the users '\My Documents\' directory, or if they have
a window open to any other directory, it copies in there.

I'm thinking that there is something cached for directory structure
that I'm missing, or something I need to clear before starting the
macro. Below is the code. I'm hoping someone will be able to help me
figure out why the duplicate file is being made and how to remove that
portion. It looks like clean code to me, so I need another pair of
eyes. I've also removed the redundant code that actually moves the
data, since it isn't really relevant to my issue.

Thanks in advance.

-Tony


Private Sub CommandButton1_Click()

Dim MyChar As String
Dim myString As String
Dim NDApath As String
Dim NDAfile As String
Dim NDAfileChk As String
Dim templatedir As String
Dim templatefile As String
Dim targetfile As String
Dim spreadsheetfile As String
Dim BDRpath As String
Dim BDRfile As String
Dim BDRfileChk As String

ColBDRid = 2
ColContainerId = 1
templatedir = "C:\WINDOWS\desktop\hsgbdrwwis\"
NDApath = "\\Torr\NTL Certification\SRS NDA IQ-3 BDRs\"
BDRpath = "\\Torr\NTL Certification\HSG BDRs"
templatefile = "SRS Template 3.xls"

Worksheets("Sheet1").Range("E2:AX5000").ClearConte nts
tmpfileChk = Dir(templatedir + templatefile) 'sanity check to see
if the template is available
If tmpfileChk < "" Then

ThisWorkbook.Windows(1).WindowState = xlMaximized
For x = 2 To 5000
If Trim(Sheet1.Cells(x, 1)) = "" And Trim(Sheet1.Cells(x, 2)) = ""
And Trim(Sheet1.Cells(x, 3)) = "" Then
Exit For
Else

'copy the template to the containerID

spreadsheetfile = templatedir + templatefile
targetfile = Trim(Sheet1.Cells(x, 1)) & ".xls"
FileCopy spreadsheetfile, targetfile

'NDA Transfer

NDAfile = NDApath + Trim(Sheet1.Cells(x, 3)) + "\" +
Trim(Sheet1.Cells(x, 1)) + "\*.TMU"
NDAfileChk = Dir(NDAfile)

If NDAfileChk < "" Then
NDAfile = NDApath + Trim(Sheet1.Cells(x, 3)) + "\" +
Trim(Sheet1.Cells(x, 1)) + "\" + NDAfileChk
Sheet1.Cells(x, 5) = " Working...." ' Write
status to main sheet

Open NDAfile For Input As #1 ' Open file for
reading.


Workbooks.Open (targetfile) ' Open spreadsheet
file for writing.
ActiveWorkbook.Windows(1).WindowState = xlMinimized

DoEvents ' Give Excel the
buffer to work

Do While Not EOF(1) ' Loop until end
of file.
MyChar = Input(1, #1) ' Read next
character of data.

<<working meat code snipped

Close #1 ' Close reading
file.
Application.DisplayAlerts = False 'Turn off before
saving
Workbooks(targetfile).SaveAs templatedir + targetfile,
FileFormat:=xlNormal ' Save drum datafile
Workbooks(targetfile).Close ' Close drum
datafile.
Application.DisplayAlerts = True 'Turn back on

End If

Sheet1.Cells(x, 5) = " Finished"
Next
Sheet1.Cells(x, 5) = "EOF reached.."
Else
MsgBox "The " + templatefile + " file does not exist in the directory
" + templatedir
End If
MsgBox " Transfer Completed "

End Sub
Sub noesc()
'set it up so if user hits esc, you send it to error handler
Application.EnableCancelKey = xlErrorHandler
On Error GoTo 1
While True
ActiveCell.Offset(1).Select 'press esc here
Wend
Exit Sub
1:
MsgBox "You pressed the Esc key"
End Sub
Sub Excelminimize()

Application.WindowState = xlMinimized

End Sub
Sub ExcelMaximize()

Application.WindowState = xlNormal

End Sub
Private Sub Workbook_Open()
Application.WindowState = xlMinimized
End Sub