Join 150,150 VB Programmers for FREE! Get instant access to thousands of VB experts, tutorials, code snippets, and more! There are 2,367 people online right now. Registration is fast and FREE... Join Now!
Hi! This project is not for any academic course (I might have questions once school starts back up, however)
I will start off by saying I do not claim to be the best searcher on the net--but I've put a fair amount of effort into searching--and haven't found anything that talks about QUITE what I need to do.
Also, I attempted to ask this question on another forum, but the admin has some issue and banned me for no reason (I promise--they did not give a coherent reason for the ban. I contacted their admin, no response. I am considering taking legal action against their forum because I feel it discriminates against users with Asperger's Syndrome, like myself.) For your reference, I asked the question on the ozgrid.com forums. I read and adhered to all their forum rules to the best of my ability. For the record, I would advise anyone from ever posting on their forums.
I am working on a project to create a spreadsheet that archives a list of all files on CD-R's along with user-input categories (like who the disc is by. Microsoft, for example)
I was going to use good old command prompt dir > text, but then I found a better solution--an exe file that exports all the files properties nicely to csv text file. It also includes MD5 checking--nice for checking for duplicate files across the discs.
The last time I did anything with VB was over 13 years ago in middle school, so I'm a little rusty. I've done searching on the net over the past week to help refresh my memory. I saw the sticky thread to the Ebook, but the link was broken. If anyone has that reference, I would REALLY appreciate it.
I have already figured out how to write the code to take the output of the CSV .txt file into the excel spreadsheet & do what it needs to do. I will post the code below:
I am designing this in the VBA macro tool thing by Microsoft. I do not have visual studio on this computer--just what comes with MS Office. You will see some of my comments in the code--they aren't directed to anyone on the forum; more to myself than anything else.
CODE
Sub ImportNewer() ' ' ImportNewer Macro ' Macro recorded 7/30/2008 by cjmountford '
' Dim sFilename, shtMain As Worksheet, shtTemp As Worksheet Dim shtFull As Worksheet, r1 As Long, r2 As Long, nBottomRow As Long Dim discNumber ' NOT SURE IF I WANT TO FORMAT THIS AS INTEGER, OR WHAT Dim rowCountTemp As Long, rowCountTemp2 As Long Dim discBy
'.GetOpenFilename("Comm Separated Value Files (*.csv), *.csv") discNumber = InputBox("Enter Disc Number") discBy = InputBox("Enter 'By' Field (Person/Company who made disc)")
' might want to do disc# as string so says Disc 4 or whatever sFilename = Application _ .GetOpenFilename("Add csv text (*.txt), *.txt") If sFilename <> False Then Sheets("Temp").Select '<--this makes temp the active sheet With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & sFilename, Destination:=Range("B1")) '.Name = "CSV" Worksheets("Temp").Cells.ClearContents Columns("A:I").Select Selection.Delete Shift:=xlToLeft ActiveWindow.SmallScroll Down:=-15 '! check this out Range("B1").Select .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 437 .TextFileStartRow = 4 'if want to skip headers, make this 4, if 'want to have headers, make =3 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With End If
'SUGGESTION!!!! TRY TO MAKE AN IF STATEMENT TO CHECK IF TEXT IT'S OPENING 'IS NOT LONG ENOUGH (ONLY HAS 1st LINE)...MAKE SURE TO USE THIS IF AUTOMATING 'CMD SCRIPT AS WELL; filelist.exe may be returning essentially blank 'document b/c disc not ready, etc.
Sheets("Temp").Select With ActiveSheet nBottomRow = .Range("B" & .Rows.Count).End(xlUp).Row ' ONE EXAMPLE HAS + 1!!! 'This represents # rows in column B of sheet Temp MsgBox (nBottomRow & " is the last row of column B in Temp") End With
Set shtMain = Sheets("Main") Set shtTemp = Sheets("Temp") Set shtFull = Sheets("Full")
Sheets("Temp").Select r1 = shtFull.Range("A" & Rows.Count).End(xlUp).Row + 1 MsgBox (r1 & " is r1, or the cell after the last non-blank row")
rowCountTemp = 0 For rowOfAFull = r1 To r1 + nBottomRow - 1 rowCountTemp = rowCountTemp + 1 shtFull.Cells(rowOfAFull, 1) = "Disc " & discNumber shtFull.Cells(rowOfAFull, 2) = shtTemp.Cells(rowCountTemp, 2).Text shtFull.Cells(rowOfAFull, 3) = shtTemp.Cells(rowCountTemp, 3).Text shtFull.Cells(rowOfAFull, 4) = shtTemp.Cells(rowCountTemp, 4).Text shtFull.Cells(rowOfAFull, 5) = shtTemp.Cells(rowCountTemp, 5).Text shtFull.Cells(rowOfAFull, 6) = shtTemp.Cells(rowCountTemp, 6).Text ' I used .Text to get around issue of date screwing up shtFull.Cells(rowOfAFull, 7) = shtTemp.Cells(rowCountTemp, 7).Text shtFull.Cells(rowOfAFull, 8) = shtTemp.Cells(rowCountTemp, 8).Text shtFull.Cells(rowOfAFull, 9) = shtTemp.Cells(rowCountTemp, 9).Text
Next rowOfAFull
r2 = shtMain.Range("A" & Rows.Count).End(xlUp).Row + 1 MsgBox (r2 & " is r2, or the cell after the last non-blank row in sheet 'Full'") rowCountTemp2 = 0 For rowOfAMain = r2 To r2 + nBottomRow - 1 rowCountTemp2 = rowCountTemp2 + 1 shtMain.Cells(rowOfAMain, 1) = "Disc " & discNumber shtMain.Cells(rowOfAMain, 2) = discBy shtMain.Cells(rowOfAMain, 3) = shtTemp.Cells(rowCountTemp2, 2).Text shtMain.Cells(rowOfAMain, 4) = shtTemp.Cells(rowCountTemp2, 8).Text Next rowOfAMain
For the first part (dealing with the filelist.exe program), I'd like to automate it to make it very user friendly & nearly foolproof. I want this to be accessible via excel's macro/VBA tool.
Filelist.exe uses the following syntax to generate the file like I want:
in command prompt: c:\temp\filelist.exe /MD5 "driveletter":\ > c:\temp\"discnumber".txt
(MD5 is an option to get MD5 check)
I want driveletter & discnumber to be input by user--ideally have the VB code substitute these into the syntax I listed above.
I had looked at using the Shell command. I saw a similar thread regarding using shell to call out an external .exe, but the person seems to be running into the same issue as me---being unable to get text output properly.
I also thought about using VBA to 1.) get the user input, 2.) WRITE a .bat file to call out the .exe file with the proper syntax BASED on the input, 3.) run that .bat file.
However, I couldn't quite figure out/remember how to accomplish this.
I had tried
CODE
Public Sub CmdCheck() Dim RetVal RetVal = Shell("C:\Temp\Filelist.exe /MD5 d:/ >c:\temp\discwhatever.txt")
End Sub
However, it doesn't perform the text output.
I also tried a suggestion I read about...putting the arguments in quotes. It didn't like this one bit.
Please note: At this stage, I'm just trying to get the text exporting process to work. I currently have no idea how to do the custom syntax; so I'm trying to get the simple version to work before trying the complicated one using the inputs)
------------------------------------------------------------ A link to a helpful page, thread, or guide would be great.
Suggestions would be preferred, but I am willing to try to figure it out if I have a resource available to do so.
Still no idea as to the questions asked previously.
I'm also now looking at incorporating a check to see if that disc # has already been entered in the spreadsheet...and if it has, prompt the user whether to continue or not.
I was thinking of using this slightly updated code to accomplish this, but I'm getting Run Time Error '424': Object Required
slightly updated code below:
CODE
Dim sFilename, shtMain As Worksheet, shtTemp As Worksheet Dim shtFull As Worksheet, r1 As Long, r2 As Long, nBottomRow As Long Dim discNumber ' NOT SURE IF I WANT TO FORMAT THIS AS INTEGER, OR WHAT Dim rowCountTemp As Long, rowCountTemp2 As Long Dim discBy Dim findDiscStr As String Dim Cancel As Boolean Dim warningBox
'.GetOpenFilename("Comm Separated Value Files (*.csv), *.csv") discNumber = InputBox("Enter Disc Number") 'I WANT TO CHECK TO SEE IF DISC # ALREADY EXISTS!!! findDiscStr = "Disc " & discNumber Sheets("Main").Select Range("A1").Select If Cells.Find(What:="findDiscStr", After:=ActiveCell, LookIn:=xlValues, LookAt _ :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _ False, SearchFormat:=False).Activate.Found = True Then warningBox = MsgBox("Warning! Disc " & discNumber & " already appears in Disc Database! " _ & "Do you want to continue?", vbYesNo) If warningBox = vbNo Then Cancel = True Else: Cancel = False End If
discBy = InputBox("Enter 'By' Field (Person/Company who made disc)")
'...this is where my code becomes the same as code I posted previously
Any idea what I'm doing wrong? Also, I still would like to accomplish what I asked previously. I apologize if the bump is rude; I am not sure what is considered a normal wait time before bumping on this forum.
I have managed to solve the isssue of calling out the external command prompt .exe file. I decided to use VBA to write a .bat file that would call out the filelist.exe file.
Right now I'm just working out bugs & trying to figure out ways to perform checks for user error
Please see commented aspects of text for issues in question. Some of my comments are more to me than anything else
Still unresolved is the error in the code to find if Disc ___ has already been entered; and if so, prompt user whether to continue or break.
I'm also working on figuring out code to check if the file about to be written by the filelist.exe already exists. This shouldn't be too much of a problem for me.
I'm also thinking about having a final prompt before the code actually performs the operation of importing the text from the CSV .txt file . The prompt would be something like: "You have entered Disc ___, By: _______. Is this correct?" I'm thinking about using vbYesNo. If answered no, then it will break. If yes, it will continue.
New code pasted below!
CODE
Sub ImportNewer() ' ' Macro By CJMountford; Note: many code snippets borrowed from internet.
' Dislcaimers/warnings: You can currently expect the macro to have issues ' if you cancel out of any of the boxes. It will, unfortunately, still copy erroneous ' data. If you, for any reason, need to hit cancel in any of the dialog boxes, ' be sure to clear the past disc & redo that part as it will most likely copy it redundantly ' You will need to perform this clear operation on both Main and Full sheets
' NOTE/EDIT: Currently, if no file is selected, it will not erroneously copy ' the code. However, if a file is selected, it will still values incorrectly
'NOW I'M ADDING CODE FOR COMMAND PROMPT CALLOUT!!!
Const MY_FILENAME = "c:\TEMP\RUNFILELIST_EXE.BAT"
Dim OutFile As Integer Dim retVal As Variant Dim DiscNumber As Integer Dim OutFileNamePath Dim CDDriveLetter
Dim sFilename, shtMain As Worksheet, shtTemp As Worksheet Dim shtFull As Worksheet, r1 As Long, r2 As Long, nBottomRow As Long
Dim rowCountTemp As Long, rowCountTemp2 As Long Dim discBy Dim findDiscStr As String Dim Cancel As Boolean Dim warningBox
OutFile = FreeFile()
'.GetOpenFilename("Comm Separated Value Files (*.csv), *.csv") DiscNumber = InputBox("Enter Disc Number") 'I WANT TO CHECK TO SEE IF DISC # ALREADY EXISTS somehow (if possible)!!! CDDriveLetter = InputBox("Please type letter of drive where CD can be found--WITHOUT any special characters. Example: D NOTE: NOT D:\)") OutFileNamePath = "C:\Temp\Disc" & DiscNumber & ".txt"
'creat batch file to run FILELIST.EXE Open MY_FILENAME For Output As #OutFile Print #OutFile, "@ECHO THE MD5 CALCULATION PART OF THIS MAY CAUSE IT TO BE VERY SLOW FOR SOME DISCS." Print #OutFile, "@ECHO PLEASE BE PATIENT. IT JUST TAKES TIME." Print #OutFile, "C:\Temp\filelist.exe /MD5 " & CDDriveLetter & ":\ " & ">" & OutFileNamePath & Chr(34) 'Print #OutFile, "cd " & Chr(34) & "V:\prod\" & Chr(34) 'use chr(34) to output double quotes as part of the string 'Print #OutFile, "DIR A3* /A-D /S /B > T:\Onaka\!Path.txt" Print #OutFile, "exit" Close #OutFile
' NOTE THE BATCH FILE WILL RUN, BUT THE CODE WILL CONTINUE TO RUN. If retVal = 0 Then MsgBox "An Error Occured" Close #OutFile End End If
'Delete batch file 'Kill MY_FILENAME
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! '----------------------------------------------------------------------- '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 'This is where old code begins (before I added the command prompt .bat file code shown above)
findDiscStr = "Disc " & DiscNumber Sheets("Main").Select Range("A1").Select ' If Cells.Find(What:=findDiscStr, After:=ActiveCell, LookIn:=xlValues, LookAt _ ' :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _ ' False, SearchFormat:=False).Activate.Found = True Then ' warningBox = MsgBox("Warning! Disc " & discNumber & " already appears in Disc Database! " _ ' & "Do you want to continue?", vbYesNo) ' If warningBox = vbNo Then Cancel = True ' Else: Cancel = False ' End If
'ALSO WANT TO ADD CODE TO NOT ADD STUFF IF CANCEL OUT & NO FILE NAME; 'IT CURRENTLY ADDS WHATEVER'S ALREADY IN TEMP IF NO FILE NAME SELECTED!!!! '...but just with Disc ___ (no number)
'NEED TO ALLOW SO IT WILL CANCEL EVERYTHING IF USER EVER HITS CANCEL; 'BECAUSE OTHERWISE WOULD POSSIBLY COPY STUFF FROM LAST TEMP UNDER NEW DISC # INPUT
discBy = InputBox("Enter 'By' Field (Person/Company who made disc). If unsure/unable to find, type ???")
' might want to do disc# as string so says Disc 4 or whatever ' sFilename = Application _ ' THIS IS OLD CODE ' .GetOpenFilename("Add csv text (*.txt), *.txt") ' THIS IS OLD CODE
' I THINK I WANT TO INSERT BREAK/PAUSE HERE TO WAIT FOR CMD PROMPT OUTPUT TO FINISH BEFORE ' ALLOWING USER TO INPUT MORE INFO IN MSG BOX!!!!
If sFilename <> False Then Sheets("Temp").Select '<--this makes temp the active sheet With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & sFilename, Destination:=Range("B1")) '.Name = "CSV" Worksheets("Temp").Cells.ClearContents Columns("A:I").Select Selection.Delete Shift:=xlToLeft ActiveWindow.SmallScroll Down:=-15 '! check this out Range("B1").Select .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 437 .TextFileStartRow = 4 'if want to skip headers, make this 4, if 'want to have headers, make =3 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With
'BELOW CODE HAS BEEN MOVED FROM OUTSIDE IF LOOP TO HERE TO TEST 'IF IT RESOLVES ERRONEOUS COPYING ISSUE
Sheets("Temp").Select With ActiveSheet nBottomRow = .Range("B" & .Rows.Count).End(xlUp).Row 'This represents # completed rows in column B of sheet Temp ' MsgBox (nBottomRow & " is the last row of column B in Temp") 'just commenting out this text ' to eliminate the prompt to click End With
Set shtMain = Sheets("Main") Set shtTemp = Sheets("Temp") Set shtFull = Sheets("Full")
Sheets("Temp").Select r1 = shtFull.Range("A" & Rows.Count).End(xlUp).Row + 1 ' MsgBox (r1 & " is r1, or the cell after the last non-blank row") ' AGAIN, commenting out ' to avoid having to click
rowCountTemp = 0 For rowOfAFull = r1 To r1 + nBottomRow - 1 rowCountTemp = rowCountTemp + 1 shtFull.Cells(rowOfAFull, 1) = "Disc " & DiscNumber shtFull.Cells(rowOfAFull, 2) = shtTemp.Cells(rowCountTemp, 2).Text shtFull.Cells(rowOfAFull, 3) = shtTemp.Cells(rowCountTemp, 3).Text shtFull.Cells(rowOfAFull, 4) = shtTemp.Cells(rowCountTemp, 4).Text shtFull.Cells(rowOfAFull, 5) = shtTemp.Cells(rowCountTemp, 5).Text shtFull.Cells(rowOfAFull, 6) = shtTemp.Cells(rowCountTemp, 6).Text ' I used .Text to get around issue of date screwing up shtFull.Cells(rowOfAFull, 7) = shtTemp.Cells(rowCountTemp, 7).Text shtFull.Cells(rowOfAFull, 8) = shtTemp.Cells(rowCountTemp, 8).Text shtFull.Cells(rowOfAFull, 9) = shtTemp.Cells(rowCountTemp, 9).Text
Next rowOfAFull
r2 = shtMain.Range("A" & Rows.Count).End(xlUp).Row + 1 ' MsgBox (r2 & " is r2, or the cell after the last non-blank row in sheet 'Full'") ' (commenting out above code to avoid having to click) rowCountTemp2 = 0 For rowOfAMain = r2 To r2 + nBottomRow - 1 rowCountTemp2 = rowCountTemp2 + 1 shtMain.Cells(rowOfAMain, 1) = "Disc " & DiscNumber shtMain.Cells(rowOfAMain, 2) = discBy shtMain.Cells(rowOfAMain, 3) = shtTemp.Cells(rowCountTemp2, 2).Text shtMain.Cells(rowOfAMain, 4) = shtTemp.Cells(rowCountTemp2, 8).Text Next rowOfAMain
End If
'SUGGESTION!!!! TRY TO MAKE AN IF STATEMENT TO CHECK IF TEXT IT'S OPENING 'IS NOT LONG ENOUGH (ONLY HAS 1st LINE)...MAKE SURE TO USE THIS IF AUTOMATING 'CMD SCRIPT AS WELL; filelist.exe may be returning essentially blank 'document b/c disc not ready, etc.
'The following code will clear "Temp." Hopefully this may resolve some of the 'erroneous insertion upon cancel (mentioned at start of code)
Sheets("Temp").Select '<--this makes temp the active sheet With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & sFilename, Destination:=Range("B1"))
Worksheets("Temp").Cells.ClearContents Columns("A:I").Select Selection.Delete Shift:=xlToLeft End With
I have bumped it a couple times and still no replies.
This code is giving me fits. I had the certain parts working fine this morning; but as I tried to make it more able to detect whether the input DiscNumber was an integer & giving a smarter output error message, I lost the functionality of the previous code!
It's driving me nuts, and I can't seem to figure out how to get it to go back to how it was!
This morning: I was able to have it successfully check to see if the disc__.txt already exists, and if so,l to have it warn you that the file exists & ask if you want to enter another number or cancel. It also worked to check to see if Disc [discnumber] appeared in the spreadsheet and do the same thing--successfully
I had originally run into trouble with it giving an error if the user hit cancel, which I was able to get around with On Error GoTo (spot right before end). I wanted to avoid such a blanket situation (every error goes makes it stop)---so I was going to use the integer check, etc.
I also had successfully implemented the message box right before the code takes the text output from filelist.exe & works it into the spreadsheet.
Now everything's all screwy & I can't figure out why =(
Please help!
CODE
Sub ImportNewer() ' ' Macro By CJMountford; Note: many code snippets borrowed from internet.
' Dislcaimers/warnings: You can currently expect the macro to have issues ' if you cancel out of any of the boxes. It will, unfortunately, still copy erroneous ' data. If you, for any reason, need to hit cancel in any of the dialog boxes, ' be sure to clear the past disc & redo that part as it will most likely copy it redundantly ' You will need to perform this clear operation on both Main and Full sheets
'NOW I'M ADDING CODE FOR COMMAND PROMPT CALLOUT!!!
Restart:
Const MY_FILENAME = "c:\TEMP\RUNFILELIST_EXE.BAT"
Dim OutFile As Integer Dim retVal As Variant Dim DiscNumber As Integer 'FOR CHECKING, would probably needf to change to boolean
Dim OutFileNamePath Dim CDDriveLetter
Dim sFilename, shtMain As Worksheet, shtTemp As Worksheet Dim shtFull As Worksheet, r1 As Long, r2 As Long, nBottomRow As Long
Dim rowCountTemp As Long, rowCountTemp2 As Long Dim discBy Dim findDiscStr As String Dim Cancel As Boolean Dim warningCellBox Dim warningFileBox Dim rngFound As Range Dim lastPrompt Dim lastWarning Dim discNumberError1 'Dim isDiscInteger As Boolean 'Dim A As Single 'Dim B As Long 'Dim C As Single
OutFile = FreeFile()
InputDiscNumber:
' On Error GoTo EndCancel ' THIS WAS OLD CODE. ' On Error GoTo ErrorCheck 'I DON'T LIKE HOW IT WON'T PROMPT USER IF THEY LEAVE 'FORM BLANK OR ENTER NON INTEGER DISC #. ' I might want to do something On Error goto a line that checks if it's an ' Integer, if not then ask you if you want to cancel or try again. Then goto ' InputDiscNumber
' On Error Resume Next 'ANOTHER THOUGHT I HAD...commenting out for now.
'TryAgain: DiscNumber = InputBox("Enter Disc Number--Positive Integer Only") 'I WANT TO CHECK TO SEE IF DISC # ALREADY EXISTS somehow (if possible)!!!
ErrorCheck:
' COMMENTED OUT FOR NOW; NOT WORKING!!!
' isDiscInteger = IsNumeric(DiscNumber) ' If isDiscInteger Then ' A = CSng(DiscNumber) ' B = CLng(A) ' C = CSng(B) ' End If
' If isDiscInteger And C = A Then ' GoTo Part1 ' Else
' discNumberError1 = MsgBox("It appears you did not enter a valid, " _ ' & "POSITIVE, INTEGER value for DiscNumber. Try again.") ' ' ElseIf DiscNumber = "" Then GoTo EndCancel
'CHECK TO SEE IF THAT TEXT FILE ALREADY EXISTS: If Len(Dir(OutFileNamePath)) > 0 Then 'NOTE: I might also be able to accomplish this with FileExists()
Select Case warningFileBox = MsgBox("Uh oh! " & OutFileNamePath & " already exists! " _ & "Please select another file number or cancel (if you want to check spreadsheet). " _ & "You may need to delete the existing file: " & OutFileNamePath, vb script:
If sFilename <> False Then Sheets("Temp").Select '<--this makes temp the active sheet With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & sFilename, Destination:=Range("B1")) '.Name = "CSV" Worksheets("Temp").Cells.ClearContents Columns("A:I").Select Selection.Delete Shift:=xlToLeft ActiveWindow.SmallScroll Down:=-15 '! check this out Range("B1").Select .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 437 .TextFileStartRow = 4 'if want to skip headers, make this 4, if 'want to have headers, make =3 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With
Sheets("Temp").Select With ActiveSheet nBottomRow = .Range("B" & .Rows.Count).End(xlUp).Row 'This represents # completed rows in column B of sheet Temp ' MsgBox (nBottomRow & " is the last row of column B in Temp") 'just commenting out this text ' to eliminate the prompt to click End With
Set shtMain = Sheets("Main") Set shtTemp = Sheets("Temp") Set shtFull = Sheets("Full")
Sheets("Temp").Select r1 = shtFull.Range("A" & Rows.Count).End(xlUp).Row + 1 ' MsgBox (r1 & " is r1, or the cell after the last non-blank row") ' AGAIN, commenting out ' to avoid user having to click. This option was for diagnostic purposes during development
rowCountTemp = 0 For rowOfAFull = r1 To r1 + nBottomRow - 1 rowCountTemp = rowCountTemp + 1 shtFull.Cells(rowOfAFull, 1) = "Disc " & DiscNumber shtFull.Cells(rowOfAFull, 2) = shtTemp.Cells(rowCountTemp, 2).Text shtFull.Cells(rowOfAFull, 3) = shtTemp.Cells(rowCountTemp, 3).Text shtFull.Cells(rowOfAFull, 4) = shtTemp.Cells(rowCountTemp, 4).Text shtFull.Cells(rowOfAFull, 5) = shtTemp.Cells(rowCountTemp, 5).Text shtFull.Cells(rowOfAFull, 6) = shtTemp.Cells(rowCountTemp, 6).Text ' I used .Text to get around issue of date screwing up shtFull.Cells(rowOfAFull, 7) = shtTemp.Cells(rowCountTemp, 7).Text shtFull.Cells(rowOfAFull, 8) = shtTemp.Cells(rowCountTemp, 8).Text shtFull.Cells(rowOfAFull, 9) = shtTemp.Cells(rowCountTemp, 9).Text
Next rowOfAFull
r2 = shtMain.Range("A" & Rows.Count).End(xlUp).Row + 1 ' MsgBox (r2 & " is r2, or the cell after the last non-blank row in sheet 'Full'") ' (commenting out above code to avoid having to click) rowCountTemp2 = 0 For rowOfAMain = r2 To r2 + nBottomRow - 1 rowCountTemp2 = rowCountTemp2 + 1 shtMain.Cells(rowOfAMain, 1) = "Disc " & DiscNumber shtMain.Cells(rowOfAMain, 2) = discBy shtMain.Cells(rowOfAMain, 3) = shtTemp.Cells(rowCountTemp2, 2).Text shtMain.Cells(rowOfAMain, 4) = shtTemp.Cells(rowCountTemp2, 8).Text Next rowOfAMain
End If End If
'SUGGESTION!!!! TRY TO MAKE AN IF STATEMENT TO CHECK IF TEXT IT'S OPENING 'IS NOT LONG ENOUGH (ONLY HAS 1st LINE)...MAKE SURE TO USE THIS IF AUTOMATING 'CMD SCRIPT AS WELL; filelist.exe may be returning essentially blank 'document b/c disc not ready, etc. 'Also: If it's not running properly, be sure that this spreadsheet 'is the only currently open spreadsheet.
'The following code will clear "Temp." Hopefully this may resolve some of the 'erroneous insertion upon cancel (mentioned at start of code)
GoTo TempDelete
EndCancel:
Select Case lastWarning = MsgBox("Operation cancelled. Possible reasons: Cancelled by user, " _ & "No value entered, or incorrect type of input entered " _ & "(Example: For 'Disc Number' field, it requires an integer. If you type a letter, " _ & "it will cancel.) Do you want to start over?", vbYesNo, "Operation Cancelled") Case vbNo GoTo TempDelete Case vbYes GoTo InputDiscNumber End Select
TempDelete:
Sheets("Temp").Select '<--this makes temp the active sheet With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & sFilename, Destination:=Range("B1"))
Worksheets("Temp").Cells.ClearContents Columns("A:I").Select Selection.Delete Shift:=xlToLeft End With
End Sub
This post has been edited by cmount: 6 Aug, 2008 - 11:18 AM
Please don't create a new thread to bump an old one.
Threads merged.
I'm sorry =(
Anybody have any clues at all? I think I realize that I need to start out the Case thing with the Cancel case, then use Case Else to handle the part if the user clicks OK.
Working on the code now. Please bear in mind I'm a borderline n00b at VB...I supposedly took a course in middle school that was supposed to teach me VB, but the class was more or less a disaster b/c of a lot of issues. We ended up spending more time waiting for the teacher to come around to look at code than actually learning. Plus that was over 10 years ago that I took that class. I just started working on this project around a week & a half ago, so I'm learning VB as I go =/
If my questions are dumb, I apologize---I sometimes get stumped over minor details although I think I'm at least moderately intelligent
Still running into Runtime Errors the 2nd time through:
My error handling handles the user cancelling the first inputbox correctly---the first time. After clicking cancel the first time, it takes them to the prompt asking them if they really want to cancel or if they want to start over. If they click start over, & then click cancel AGAIN, my error handling gives the runtime error that my error handling code got around the first time.
Everything else in my code is decently solid.
Any idea what's causing my runtime error the 2nd time through & how to fix it?
Thanks in advance
CODE
Sub ImportNewer() ' ' Macro By CJMountford; Note: many code snippets borrowed from internet.
' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ' REMINDER I STILL NEED TO GO IN & DELETE "Dummy" Debugging MsgBoxes!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
' if cancel out of first input box twice, may receive runtime error (hit cancel, then when prompts you ' if you want to try again, you hit Yes. Then it takes you back & you hit cancel again..it gives the runtime error ' If this happens, just re-run the macro. There is no problem aside from it didn't know how to handle you ' cancelling twice. I've looked at the code--there's no good reason it should do it the 2nd time around
Beginning:
Const MY_FILENAME = "c:\TEMP\RUNFILELIST_EXE.BAT"
Dim OutFile As Integer Dim retVal As Variant Dim DiscNumber As Integer 'FOR Error CHECKING, would probably need to change to boolean
Dim OutFileNamePath Dim CDDriveLetter Dim CDDrivePath
Dim sFilename, shtMain As Worksheet, shtTemp As Worksheet Dim shtFull As Worksheet, r1 As Long, r2 As Long, nBottomRow As Long
Dim rowCountTemp As Long, rowCountTemp2 As Long Dim discBy Dim findDiscStr As String Dim Cancel As Boolean Dim warningCellBox Dim warningFileBox Dim rngFound As Range Dim lastPrompt Dim lastWarning Dim discNumberError1 'Dim isDiscInteger As Boolean 'Dim A As Single 'Dim B As Long 'Dim C As Single Dim diagnosMsgBox Dim byWarnMsgBox Dim driveNotReadyMsgBox 'Dim tempMsgBox1 'Dim tempMsgBox2 'Dim tempMsgBox3 'Dim tempMsgBox4
Dim fs, d, s, t 'this is to initialize the parts to check if drive is ready!
OutFile = FreeFile()
InputDiscNumber: Application.EnableCancelKey = xlErrorHandler ' this allows user to cancel by escape key '
' On Error GoTo ErrorCheck 'I DON'T LIKE HOW IT WON'T PROMPT USER IF THEY LEAVE 'FORM BLANK OR ENTER NON INTEGER DISC #. ' I might want to do something On Error goto a line that checks if it's an ' Integer, if not then ask you if you want to cancel or try again. Then goto ' InputDiscNumber
' On Error Resume Next 'ANOTHER THOUGHT I HAD...commenting out for now.
'TryAgain: On Error GoTo EndCancel 'neither of these seem to help 2nd time cancelled DiscNumber = InputBox("Enter Disc NUMBER ONLY (only type the number. Example: If you're on " _ & "Disc # 4, you need to type just the number 4. Otherwise will error.") On Error GoTo EndCancel 'neither of these seem to help 2nd time cancelled 'tempMsgBox1 = MsgBox("You entered " & DiscNumber)
'STILL GETTING ERROR WHEN CANCEL 2nd time around!!!!!!!!!!!!!!!!!!!!!!!!!!!
ErrorCheck:
' COMMENTED OUT FOR NOW; NOT WORKING!!!
' isDiscInteger = IsNumeric(DiscNumber) ' If isDiscInteger Then ' A = CSng(DiscNumber) ' B = CLng(A) ' C = CSng(B) ' End If
' If isDiscInteger And C = A Then ' GoTo Part1 ' Else
' discNumberError1 = MsgBox("It appears you did not enter a valid, " _ ' & "POSITIVE, INTEGER value for DiscNumber. Try again.") ' ' ElseIf DiscNumber = "" Then GoTo EndCancel
'CHECK TO SEE IF THAT TEXT FILE ALREADY EXISTS: If Len(Dir(OutFileNamePath)) > 0 Then 'NOTE: I might also be able to accomplish this with FileExists()
'On Error GoTo EndCancel warningFileBox = MsgBox("Uh oh! " & OutFileNamePath & " already exists! " _ & "Please select another disc number or cancel. " _ & "You may need to delete the existing file: " & OutFileNamePath, vb script:
'THIS IS WHAT RUNS FILELIST.EXE: 'FIRST IT WRITES A .BAT FILE TO CALL OUT FILELIST.EXE:
Open MY_FILENAME For Output As #OutFile Print #OutFile, "@ECHO THIS MAY BE VERY SLOW ON SOME DISCS (Due to MD5 calculation)." Print #OutFile, "@ECHO PLEASE BE PATIENT. IT JUST TAKES TIME." Print #OutFile, "@ECHO THIS WINDOW WILL CLOSE AUTOMATICALLY WHEN THE PROCESS IS COMPLETE" Print #OutFile, "@ECHO PLEASE DO NOT FILL OUT THE INPUT BOX IN THE SPREADSHEET UNTIL" _ ; " THIS WINDOW CLOSES" Print #OutFile, "C:\Temp\filelist.exe /MD5 " & CDDriveLetter & ":\ " & ">" & OutFileNamePath & Chr(34) 'use chr(34) to output double quotes as part of the string Print #OutFile, "exit" Close #OutFile
'run the .BAT file: retVal = Shell(MY_FILENAME, vb script:
'THIS CODE IS USED TO IMPORT THE DATA FROM THE CSV .TXT FILE WRITTEN BY FILELIST.EXE:
If sFilename <> False Then Sheets("Temp").Select '<--this makes temp the active sheet With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & sFilename, Destination:=Range("B1")) '.Name = "CSV" Worksheets("Temp").Cells.ClearContents Columns("A:I").Select Selection.Delete Shift:=xlToLeft ActiveWindow.SmallScroll Down:=-15 '! check this out Range("B1").Select .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 437 .TextFileStartRow = 4 'if want to skip headers, make this 4, if 'want to have headers, make =3 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With
Sheets("Temp").Select With ActiveSheet nBottomRow = .Range("B" & .Rows.Count).End(xlUp).Row 'This represents # completed rows in column B of sheet Temp ' MsgBox (nBottomRow & " is the last row of column B in Temp") 'Old Diagnostic code; Ignore
End With
Set shtMain = Sheets("Main") Set shtTemp = Sheets("Temp") Set shtFull = Sheets("Full")
Sheets("Temp").Select r1 = shtFull.Range("A" & Rows.Count).End(xlUp).Row + 1 ' MsgBox (r1 & " is r1, or the cell after the last non-blank row") ' AGAIN, commenting out ' to avoid user having to click. This option was for diagnostic purposes during development
rowCountTemp = 0 For rowOfAFull = r1 To r1 + nBottomRow - 1 rowCountTemp = rowCountTemp + 1 shtFull.Cells(rowOfAFull, 1) = "Disc " & DiscNumber shtFull.Cells(rowOfAFull, 2) = shtTemp.Cells(rowCountTemp, 2).Text shtFull.Cells(rowOfAFull, 3) = shtTemp.Cells(rowCountTemp, 3).Text shtFull.Cells(rowOfAFull, 4) = shtTemp.Cells(rowCountTemp, 4).Text shtFull.Cells(rowOfAFull, 5) = shtTemp.Cells(rowCountTemp, 5).Text shtFull.Cells(rowOfAFull, 6) = shtTemp.Cells(rowCountTemp, 6).Text ' I used .Text to get around issue of date screwing up shtFull.Cells(rowOfAFull, 7) = shtTemp.Cells(rowCountTemp, 7).Text shtFull.Cells(rowOfAFull, 8) = shtTemp.Cells(rowCountTemp, 8).Text shtFull.Cells(rowOfAFull, 9) = shtTemp.Cells(rowCountTemp, 9).Text
Next rowOfAFull
r2 = shtMain.Range("A" & Rows.Count).End(xlUp).Row + 1 ' MsgBox (r2 & " is r2, or the cell after the last non-blank row in sheet 'Full'") ' (commenting out above code to avoid having to click) rowCountTemp2 = 0 For rowOfAMain = r2 To r2 + nBottomRow - 1 rowCountTemp2 = rowCountTemp2 + 1 shtMain.Cells(rowOfAMain, 1) = "Disc " & DiscNumber shtMain.Cells(rowOfAMain, 2) = discBy shtMain.Cells(rowOfAMain, 3) = shtTemp.Cells(rowCountTemp2, 6).Text shtMain.Cells(rowOfAMain, 4) = shtTemp.Cells(rowCountTemp2, 2).Text
