T
Tony
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").ClearContents
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
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").ClearContents
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
I changed my logic around and corrected the problem. Many, many