'System.IndexOutOfRangeException? Input validation? Visual Basic - vb.net

I fixed the tag, thought VBA meant visual-basic, but I'm naive in this realm.
I'm not sure what I'm doing wrong here..
I think I'm forgetting input validation near readfile() but I'm not sure how to code it.. when I run the program I get a error with currentrecord(4). Please help.. .-.
Module Module1
' IMPUT VARIABLES:
Private ProductNumberInteger As Integer
Private ProductDescriptionString As String
Private WholeSalePriceDecimal As Decimal
Private MarkupCodeInteger As Integer
Private QuantitySoldInteger As Integer
' CALCULATED VARIABLES AFTER PROCESSING:
Private CalculatedMarkupAmountDecimal As Decimal '
Private CalculatedRetailPriceDecimal As Decimal
Private CalculatedDiscountAmountDecimal As Decimal
Private CalculatedDiscountedPriceDecimal As Decimal
Private CalculatedTotalEarnedDecimal As Decimal
Private CalculatedTotalProfitDecimal As Decimal
' ASSIGNED FIELDS:
Private MarkupRateDecimal
Private DiscountPercentRateDecimal
' CONSTANT VARIABLES:
Private MARKUP_CODE_1_DECIMAL As Decimal = 1.05
Private MARKUP_CODE_2_DECIMAL As Decimal = 1.07
Private MARKUP_CODE_3_DECIMAL As Decimal = 1.1
Private MARKUP_CODE_4_DECIMAL As Decimal = 1.2
Private MARKUP_CODE_5_DECIMAL As Decimal = 1.25
Private CurrentRecord() As String
Private TURKEYSALESFILE As New Microsoft.VisualBasic.FileIO.TextFieldParser("THANKSWk44.txt")
' ACCUMULATORS
Private AccumFinalTotalWholesalePriceDecimal As Decimal
Private AccumFinalTotalMarkupAmountDecimal As Decimal
Private AccumFinalTotalProfitDecimal As Decimal
Private AccumFinalTotalNumberOfItemsSoldThisWeekInteger As Integer
' FINAL CALCULATIONS AT EOF:
Private FinalProfitRatioDecimnal As Decimal
Private FinalAverageMarkupDecimal As Decimal
' PAGINATION CODE:
Private PageSizeInteger As Integer = 15
Private LineCounterInteger As Integer = 99
Private PageNumberInteger As Integer = 1
Private RecordSelectedBoolean As Boolean
'--------------------------------------------------------------------------------------------------------------
Sub Main() ' PROGRAM STARTS HERE
Housekeeping()
Do While Not TURKEYSALESFILE.EndOfData
Call ProcessRecords()
Loop
Call EndOfJob() ' PROGRAM ENDS HERE AFTER LOOP. EOJ CHECKS FOR EOF STATUS. 1/1 = EOF
End Sub
'--------------------------------------------------------------------------------------------------------------
' LEVEL TWO PROCESSES
Private Sub Housekeeping()
SetFileDelimiter() ' SETS FILE TYPE AS DELIMITED AND ADDS A COMMA
End Sub
'--------------------------------------------------------------------------------------------------------------
Private Sub ProcessRecords()
ReadFile()
RecordSelection()
If RecordSelectedBoolean = True Then
DetailCalculations()
AccumulateTotals()
WriteDetailLine()
End If
'--------------------------------------------------------------------------------------------------------------
End Sub
Private Sub EndOfJob() ' PROGRAM END
FinalCalculations()
FinalOutput()
CloseFile()
End Sub
'--------------------------------------------------------------------------------------------------------------
Private Sub SetFileDelimiter()
TURKEYSALESFILE.TextFieldType = FileIO.FieldType.Delimited
TURKEYSALESFILE.SetDelimiters(",") ' ADDS A COMMA
End Sub
'--------------------------------------------------------------------------------------------------------------
Private Sub ReadFile() ' READS EACH RECORD IN ORDER
'Try
' TURKEYSALESFILE 'Do something dangerous
'Catch ex As System.Exception 'catch any error
' 'Handle the error here
'End Try
'Try
'Catch
' Console.WriteLine("ERROR")
'End Try
CurrentRecord = TURKEYSALESFILE.ReadFields()
ProductNumberInteger = CurrentRecord(0)
ProductDescriptionString = CurrentRecord(1)
WholeSalePriceDecimal = CurrentRecord(2)
MarkupCodeInteger = CurrentRecord(3)
QuantitySoldInteger = CurrentRecord(4)
End Sub
'--------------------------------------------------------------------------------------------------------------
Private Sub RecordSelection()
If ProductNumberInteger = 100 - 300 Or ProductNumberInteger = 400 - 500 Or ProductNumberInteger = 600 - 700 Then
RecordSelectedBoolean = True
End If
End Sub
'--------------------------------------------------------------------------------------------------------------
Private Sub DetailCalculations() ' GENERATES CALCULATIONS THAT IS TO BE APPLIED TO THE DATA SPECIFIED
CalculatedMarkupAmountDecimal = WholeSalePriceDecimal * MarkupRateDecimal
CalculatedRetailPriceDecimal = WholeSalePriceDecimal + CalculatedMarkupAmountDecimal
CalculatedDiscountAmountDecimal = CalculatedRetailPriceDecimal * DiscountPercentRateDecimal
CalculatedDiscountedPriceDecimal = CalculatedRetailPriceDecimal - CalculatedDiscountAmountDecimal
CalculatedTotalEarnedDecimal = CalculatedDiscountedPriceDecimal * QuantitySoldInteger
CalculatedTotalProfitDecimal = CalculatedTotalEarnedDecimal - (QuantitySoldInteger * WholeSalePriceDecimal)
End Sub
'--------------------------------------------------------------------------------------------------------------
Private Sub DetermineMarkupCode()
Select Case MarkupCodeInteger
Case Is = 1
MarkupCodeInteger = MARKUP_CODE_1_DECIMAL
Case = 2
MarkupCodeInteger = MARKUP_CODE_2_DECIMAL
Case = 3
MarkupCodeInteger = MARKUP_CODE_3_DECIMAL
Case = 4
MarkupCodeInteger = MARKUP_CODE_4_DECIMAL
Case Else
MarkupCodeInteger = MARKUP_CODE_5_DECIMAL
End Select
End Sub
'--------------------------------------------------------------------------------------------------------------
Private Sub DetermineDiscountAmount()
If QuantitySoldInteger = 0 - 10 Then
DiscountPercentRateDecimal = 1.0
Else
If QuantitySoldInteger = 11 - 25 Then
DiscountPercentRateDecimal = 10.0
Else
If QuantitySoldInteger = 26 - 40 Then
DiscountPercentRateDecimal = 12.5
Else
If QuantitySoldInteger = 41 - 50 Then
DiscountPercentRateDecimal = 20.0
Else
DiscountPercentRateDecimal = 25.5
End If
End If
End If
End If
End Sub
'--------------------------------------------------------------------------------------------------------------
Private Sub AccumulateTotals()
AccumFinalTotalWholesalePriceDecimal += WholeSalePriceDecimal
AccumFinalTotalMArkupAmountDecimal += CalculatedMarkupAmountDecimal
AccumFinalTotalProfitDecimal += CalculatedTotalProfitDecimal
AccumFinalTotalNumberOfItemsSoldThisWeekInteger += 1
End Sub
'--------------------------------------------------------------------------------------------------------------
Private Sub WriteDetailLine()
If LineCounterInteger > PageSizeInteger Then
WriteHeaders()
End If
' DETAIL LINE OUTPUT
Console.WriteLine(ProductNumberInteger.ToString().PadRight(3) &
Space(1) & ProductDescriptionString.PadLeft(12) &
Space(1) & WholeSalePriceDecimal.ToString("N").PadLeft(5) &
Space(2) & MarkupCodeInteger.ToString() &
Space(1) & CalculatedMarkupAmountDecimal.ToString("N").PadLeft(5) &
Space(2) & CalculatedRetailPriceDecimal.ToString("N").PadLeft(6) &
Space(1) & DiscountPercentRateDecimal.ToString("n0") &
Space(1) & CalculatedDiscountAmountDecimal.ToString("N").PadLeft(5) &
Space(2) & QuantitySoldInteger.ToString().PadLeft(2) &
Space(2) & CalculatedDiscountedPriceDecimal.ToString("N").PadLeft(6) &
Space(1) & CalculatedTotalEarnedDecimal.ToString("N").PadLeft(8) &
Space(2) & CalculatedTotalProfitDecimal.ToString("N").PadLeft(6))
LineCounterInteger += 1
End Sub
'--------------------------------------------------------------------------------------------------------------
Private Sub WriteHeaders()
Console.WriteLine("Page" & PageNumberInteger.ToString("n0").PadLeft(3) &
Space(18) & "Sales and Profit Report for")
Console.WriteLine(Space(25) & "Thanks for Thanksgiving, Inc.,")
Console.WriteLine(Space(32) & "by Nathaniel Kulinski")
Console.WriteLine()
Console.WriteLine("Item Desc" &
Space(6) & "WhlSale" &
Space(1) & "-Markup-" &
Space(2) & "Retail" &
Space(1) & "-Discount-" &
Space(1) & "Qty" &
Space(2) & "Discnt" &
Space(4) & "Total")
Console.WriteLine("Num" &
Space(14) & "Price" &
Space(1) & "Code" &
Space(1) & "Amt" &
Space(2) & "Price" &
Space(5) & "%" &
Space(3) & "Amt" &
Space(1) & "Sld" &
Space(3) & "Price" &
Space(3) & "Earned" &
Space(2) & "Profit")
Console.WriteLine()
LineCounterInteger = 1
PageNumberInteger += 1
End Sub
'--------------------------------------------------------------------------------------------------------------
Private Sub FinalCalculations()
FinalProfitRatioDecimnal = AccumFinalTotalProfitDecimal / AccumFinalTotalWholesalePriceDecimal
FinalAverageMarkupDecimal = AccumFinalTotalMarkupAmountDecimal / AccumFinalTotalNumberOfItemsSoldThisWeekInteger
End Sub
Private Sub FinalOutput()
Console.WriteLine()
Console.WriteLine(Space(1) & "FINAL TOTALS:")
Console.WriteLine(Space(5) & "Wholesale Price" &
Space(6) & AccumFinalTotalWholesalePriceDecimal.ToString("C").PadLeft(9))
Console.WriteLine(Space(5) & "Markup Amount" &
Space(8) & AccumFinalTotalMarkupAmountDecimal.ToString("C").PadLeft(9))
Console.WriteLine(Space(5) & "Profit" &
Space(15) & AccumFinalTotalProfitDecimal.ToString("C").PadLeft(9))
Console.WriteLine(Space(5) & "Items Sold" &
Space(12) & AccumFinalTotalNumberOfItemsSoldThisWeekInteger.ToString("N").PadLeft(5))
Console.WriteLine()
Console.WriteLine(Space(5) & "Profit Ratio" &
Space(11) & FinalProfitRatioDecimnal.ToString("C").PadLeft(7))
Console.WriteLine(Space(5) & "Avg Markup Per Item" &
Space(5) & FinalAverageMarkupDecimal.ToString("C").PadLeft(6))
End Sub
Private Sub CloseFile() ' END OF PROGRAM
Console.WriteLine()
Console.WriteLine()
Console.WriteLine()
Console.WriteLine("Press Enter To Close Window") ' PROMPT FOR THE USER TO CLOSE THE PROGRAM
Console.ReadLine()
TURKEYSALESFILE.Close()
End Sub
End Module
I was able to get the code to output some stuff, but it was incomplete. I think there is a issue with the imput file (this is an assignment), but I'm not sure how to fix it.

Related

How to take values from an open Access continuous sub form, and "paste" them into another form?

Okay. Let me try to explain what is happening here.
User will select record in form 1 and click button.
That will open form 2 to a detail form of that record.
User will then select one or multiple codes from Form 2 and click order button.
Form 3 will open with the info from Form 2, but I am having trouble getting the codes to fill in on Form 3. This is where I need help.
Existing code as follows:
**Form 1 CODE**
Option Compare Database
Option Explicit
Private Sub RequeryForm()
Dim SQL As String, WhereStr As String
WhereStr = ""
If Search <> "" Then
If WhereStr <> "" Then WhereStr = WhereStr & " AND "
WhereStr = "LocationID Like ""*" & AccountSearch & "*"""
End If
If NameSearch <> "" Then
If WhereStr <> "" Then WhereStr = WhereStr & " AND "
WhereStr = "FirstNameLastName Like ""*" & NameSearch & "*"""
End If
If CodeSearch <> "" Then
If WhereStr <> "" Then WhereStr = WhereStr & " AND "
WhereStr = "Code Like ""*" & CodeSearch & "*"""
End If
SQL = "Select * From AMSQuery"
If WhereStr <> "" Then
SQL = SQL & " Where " & WhereStr
End If
Me.RecordSource = SQL
End Sub
Private Sub ClearSearchBtn_Click()
SetDefaults
RequeryForm
End Sub
Private Sub OpenDetailbtn_Click()
DoCmd.OpenForm "Form2", , , "LocationID=" & Me.LocationID
End Sub
Private Sub SearchBtn_Click()
RequeryForm
End Sub
Private Sub SetDefaults()
AccountSearch = Null
NameSearch = Null
CodeSearch = Null
End Sub
**Code For Form2**
Private Sub ExitBTN_Click()
DoCmd.Close acForm, "Form2"
End Sub
Private Sub OrderILbtn_Click()
DoCmd.OpenForm "RequestForm", acNormal, , , acFormAdd
End Sub
**Form 3 Code**
Option Compare Database
Option Explicit
'Private Sub IncNumber_BeforeUpdate(Cancel As Integer)
'If Not (Me!IncNumber = "IncNumber" Or (Me!IncNumber <> 11) Or IsNull(Me!IncNumber)) Then
'MsgBox "The Incident Number entered is less than 11 characters."
'Cancel = True
'End If
'End Sub
Private Sub CloseFormBtn_Click()
DoCmd.Close acForm, "Form3", acSaveYes
DoCmd.SelectObject acForm, "Form1"
End Sub
Private Sub Form_Load()
Forms!RequestForm!Account = Forms!Form2!LocationID
End Sub
Private Sub SaveBtn_Click()
If IsNull([Account]) Then
MsgBox "You forgot to add a Y account.", vbOKOnly, "Missing Y account Warning!"
Else
DoCmd.RunCommand acCmdSaveRecord
DoCmd.GoToRecord , , acNewRec
End If
'ILRequestID = "IL" & Right(Year([DateAndTimeRequested]), 2) & Format(Month([DateAndTimeRequested]), "00") & Format(Day([DateAndTimeRequested]), "00") & [EntryID]
End Sub

Cannot display number values

I just joined and hope to learn all I can here and contribute where I can.
I am having major issues with the last three sections of my VBA script.
The correct, incorrect, and percentage score values are not being displayed on slides 40 & 41.
On slide 42 I cannot get the textbox or the label to display the username, date and their overall percentage score.
Any help on slide 40 would be great and I can workout the rest.
**Sub shapeTextHappySmile()**strong text**
Sub ShapeTextSadSmile()
Sub CertificateBuld()**
Option Explicit
Dim UserName As String
Dim numberCorrect As Integer
Dim numberIncorrect As Integer
Dim numberPercentage As Integer
Dim numberTotal As Integer
Private Sub CertDate()
Dim Rdate As Variant
Rdate = Date
Rdate = Format((Date), "mmmm dd, yyyy")
End Sub
Sub Initialise()
numberCorrect = 12
numberIncorrect = 8
numberPercentage = 58
numberTotal = 20
numberTotal = (numberCorrect + numberIncorrect)
numberCorrect = (numberTotal - numberIncorrect)
numberIncorrect = (numberTotal - numberCorrect)
numberPercentage = Round(numberCorrect / numberTotal) * 100
End Sub
Sub TakeQuiz()
UserName = InputBox(Prompt:="Type Your Name! ")
MsgBox "Welcome To The Academic Online Tutorial Quiz " + UserName, vbApplicationModal, " Academic Online Tutorial Quiz"
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub Correct()
numberCorrect = numberCorrect + 1
MsgBox ("Great well Done! That's the correct answer")
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub Incorrect()
numberIncorrect = numberIncorrect + 1
MsgBox ("Sorry! That was the incorrect answer")
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub shapeTextHappySmile()
ActivePresentation.Slides(40).Shapes(Label1).TextFrame.TextRange.Text = 12
'numberCorrect
ActivePresentation.Slides(40).Shapes(Label2).TextFrame.TextRange.Text = numberPercentage & "%"
MsgBox "Great Job, Well done " + "," & "Please print a copy of your completion certificate"
MsgBox "After printing or saving a copy of your certificate, you can exit the presentation"
With SlideShowWindows(1).View
.GotoSlide 42
End With
End Sub
Sub ShapeTextSadSmile()
ActivePresentation.Slides(41).Shapes("AnsweredIncorrectly").TextFrame.TextRange.Text = numberIncorrect
ActivePresentation.Slides(41).Shapes("InCorrectPercentage").TextFrame.TextRange.Text = numberPercentage & " %"
MsgBox "Your score was below 70%, in order to pass the quiz and receive a certificate of completion you need to score 70% or more."
MsgBox "Please retake the quiz, and good luck"
With SlideShowWindows(1).View
.GotoSlide 1
End With
' I will add the option of redoing the entire presentation or just the quiz.
'see slide 19 action buttons
End Sub
Sub CertificateBuld()
MsgBox "Great Job, Well done " + "," & "Plese print a copy of your completion certificate"
MsgBox "After printing or saving a copy of your certificate, please exit the presentation"
If numberCorrect >= "14" Then
ActivePresentation.Slides(42).Shapes(" ABCDEFGHIJKLMN ").TextFrame.TextRange.Text = " ABCDEFGHIJKLMN "
ActivePresentation.Slides(42).Shapes("Rdate & Percentage").TextFrame.TextRange.Text = " ON " & Rdate & " WITH A SCORE OF " & numberPercentage & " %"
ActivePresentation.Slides(42).Shapes(UserName).TextFrame.TextRange.Text = UserName
'OR
If numberCorrect <= "14" Then
ActivePresentation.Slides(42).Shapes(8).TextFrame.TextRange.Text = ABCDEFGHIJKLMN "
ActivePresentation.Slides(42).Shapes(9).TextFrame.TextRange.Text = Rdate & " ON " & Rdate & " WITH A SCORE OF " & numberPercentage & " %"
ActivePresentation.Slides(42).Shapes(10).TextFrame.TextRange.Text = UserName
Else
ActivePresentation.SlideShowWindow.View.Save
ActivePresentation.SlideShowWindow.View.Exit
End If
End Sub
See comments inline:
Sub shapeTextHappySmile()
' This won't work:
'ActivePresentation.Slides(40).Shapes(Label1).TextFrame.TextRange.Text = 12
' Shapes have names that are strings, so you need to use .Shapes("Label1")
' Assuming this is an ActiveX label, you get at its properties a bit
' differently from regular PPT shapes, starting with:
' .Shapes("Label1").OLEFormat.Object
' And for a Label ActiveX control, the property you want is .Caption
' And finally, Text/Caption properties take a String value so you want to
' put the 12 in quotes or convert a numeric value to string using Cstr(x)
' Final version:
ActivePresentation.Slides(40).Shapes("Label1").OLEFormat.Object.Caption = "12"
'numberCorrect
' And make the same changes to this one:
ActivePresentation.Slides(40).Shapes(Label2).TextFrame.TextRange.Text = numberPercentage & "%"
' MsgBox "Great Job, Well done " + "," & "Please print a copy of your completion certificate"
' and I think you probably want to do this instead of the above:
MsgBox "Great Job, Well done" & ", " & "Please print a copy of your completion certificate"
MsgBox "After printing or saving a copy of your certificate, you can exit the presentation"
With SlideShowWindows(1).View
.GotoSlide 42
End With
End Sub

Locked files from one of the system.io classes

I am trying to develop a simple bulk copy program that polls a given folder for files at specified intervals.
The code looks perfect. My output gives a great recursive list of files, but when I go to actually move them according to the list, every file I scanned is locked. I have tried garbage collecting, disposing, exiting subs at certain points, debugging at certain points...
Please take a look at my code. When MoveFile is called, everything is locked.
Imports System
Imports System.IO
Public Structure FileStructure
Dim Enumerator As Integer
Dim SPath As String
Dim DPath As String
Dim Name As String
Dim FileSize As Long
Dim IsFile As Short
Dim SourceFullName As String
Dim DestFullName As String
End Structure
Public Class StagingDriveCoordinator
Dim FilesScanned As FileStructure()
Dim ScanCount As Integer = -1
Private Sub ScanAll(ByVal sourcePath As String, ByVal destinationPath As String)
Dim sourceDirectoryInfo As New System.IO.DirectoryInfo(sourcePath)
' ---------------------- Create the appropriate directories --------------------------------
' Create source path
If Not System.IO.Directory.Exists(sourcePath) Then
System.IO.Directory.CreateDirectory(sourcePath)
End If
' If the destination folder doesn't exist then create it
If Not System.IO.Directory.Exists(destinationPath) Then
System.IO.Directory.CreateDirectory(destinationPath)
End If
' ------------------------------------------------------------------------------------------
Dim AddSize As Integer = 0
'Figure out how much to resize the array this iteration of ScanAll
If FilesScanned IsNot Nothing Then
AddSize = FilesScanned.Count + sourceDirectoryInfo.GetFileSystemInfos.Length
Else
AddSize = sourceDirectoryInfo.GetFileSystemInfos.Length
End If
'Resize the array
Array.Resize(FilesScanned, AddSize)
For Each FileSystemInfo In sourceDirectoryInfo.GetFileSystemInfos
ScanCount += 1
FilesScanned(ScanCount).Enumerator = ScanCount
FilesScanned(ScanCount).SPath = sourcePath.ToString
FilesScanned(ScanCount).DPath = destinationPath.ToString
FilesScanned(ScanCount).Name = FileSystemInfo.Name.ToString
If TypeOf FileSystemInfo Is System.IO.FileInfo Then
FilesScanned(ScanCount).FileSize = DirectCast(FileSystemInfo, FileInfo).Length
FilesScanned(ScanCount).IsFile = 1
Else
FilesScanned(ScanCount).FileSize = 9223372036854775807
FilesScanned(ScanCount).IsFile = 0
End If
FilesScanned(ScanCount).SourceFullName = System.IO.Path.Combine(sourcePath, FileSystemInfo.Name).ToString
FilesScanned(ScanCount).DestFullName = System.IO.Path.Combine(sourcePath, FileSystemInfo.Name).ToString
txtOutput.Text += FilesScanned(ScanCount).Enumerator & vbTab & FilesScanned(ScanCount).SourceFullName & vbNewLine
If FilesScanned(ScanCount).IsFile = 0 Then
'Debug
txtOutput.Text += vbNewLine & "Recursively scanning subfolder " + FilesScanned(ScanCount).Name & "..." + vbNewLine + vbNewLine
'Recursively call the main scanner.
ScanAll(FilesScanned(ScanCount).SourceFullName, FilesScanned(ScanCount).DestFullName)
End If
Next
End Sub
Private Sub MoveFile(ByVal Source, ByVal Destination, ByVal filesize)
Try
File.Copy(Source, Destination, True)
txtOutput.Text += "Moving file... Source: " & Source & ". Filesize: " & filesize.ToString & vbNewLine
txtOutput.Text += "Destination: " & Destination & vbNewLine & vbNewLine
File.Delete(Source)
Catch ex As Exception
txtOutput.Text += "File " & Source & " is locked." & vbNewLine
End Try
End Sub
Private Sub btnStart_Click(sender As Object, e As EventArgs) Handles btnStart.Click
Select Case cmbPollingFrequency.SelectedItem
Case "5 Seconds"
Timer1.Interval = 5000
Case "30 Seconds"
Timer1.Interval = 30000
Case "1 Minute"
Timer1.Interval = 60000
Case "5 Minutes"
Timer1.Interval = 300000
Case "15 Minutes"
Timer1.Interval = 900000
Case "30 Minutes"
Timer1.Interval = 1800000
Case "1 Hour"
Timer1.Interval = 3600000
Case Else
MsgBox("You must select an interval.")
End Select
Timer1.Start()
End Sub
Private Sub TimerTick(sender As Object, e As EventArgs) Handles Timer1.Tick
Timer1.Stop()
txtOutput.Text += DateTime.Now.ToString("yyyy/MM/dd HH:mm:ss") & vbNewLine
txtOutput.Text += "Scanning Filesystem..." + vbNewLine + vbNewLine
'Scan the file system.
ScanAll(cmbStaging.Text, cmbBackup.Text)
txtOutput.Text += vbNewLine
txtOutput.Text += DateTime.Now.ToString("yyyy/MM/dd HH:mm:ss") & vbNewLine
txtOutput.Text += " ------------- Scan cycle completed. --------------- " & vbNewLine & vbNewLine
txtOutput.Text += "Sorting by filesize..." & vbNewLine & vbNewLine
' Sort the file list by size.
FilesScanned = FilesScanned.OrderBy(Function(x) x.FileSize).ToArray
txtOutput.Text += "Done." & vbNewLine & vbNewLine
txtOutput.Text += "Moving smallest files first..." & vbNewLine & vbNewLine
For Each FileElement In FilesScanned
If FileElement.IsFile > 0 Then
'file.FileSize only needed to pass size to text output
MoveFile(FileElement.SourceFullName, FileElement.DestFullName, FileElement.FileSize)
End If
Next
FilesScanned = Nothing
ScanCount = -1
Timer1.Start()
End Sub
Private Sub btnStop_Click(sender As Object, e As EventArgs) Handles btnStop.Click
Timer1.Stop()
End Sub
End Class
I found the problem. The IO system was NOT locking the file. I was trying to copy it to the SAME directory...
FilesScanned(ScanCount).SourceFullName =
System.IO.Path.Combine(sourcePath, FileSystemInfo.Name).ToString
FilesScanned(ScanCount).DestFullName =
System.IO.Path.Combine(sourcePath, FileSystemInfo.Name).ToString
This should have been:
FilesScanned(ScanCount).SourceFullName =
System.IO.Path.Combine(sourcePath, FileSystemInfo.Name).ToString
FilesScanned(ScanCount).DestFullName =
System.IO.Path.Combine(destinationPath, FileSystemInfo.Name).ToString
Once I changed it, everything worked perfectly.

Case causes blank output

I just learned Case in class and have to use it for a program. It outputs fine until I call a case then it returns blank. A lot of code is commented out as I'm recycling the program we used in class. Do I have the variables wrong in the case? As it only messes up when I call selectrecord.
Imports System
Imports System.IO
Module Module1
Private ItemDescrip As String
Private ItemNum As Integer
Private WholeSale As Decimal
Private MarkupCode As Integer
Private AmtSold As Integer
' Calculated
' Assigned Fields
Private BallNum As Integer
' Accumlated Totals
' Constants
Private BALL_CODE_1 As Integer = 150
Private BALL_CODE_2 As Integer = 200 > 299
Private BALL_CODE_3 As Integer = 300 > 399
Private BALL_CODE_4 As Integer = 400 > 499
Private BALL_CODE_5 As Integer = 500 > 599
Private BALL_CODE_6 As Integer = 600 > 699
'Pagination Fields
Private PageSize As Integer = 15
Private LineCounter As Integer = 99
Private PageNum As Integer = 1
'Working Fields
Private CurrentRecord() As String
Private BallFile As New Microsoft.VisualBasic.FileIO.TextFieldParser("BALLFILE.txt")
'Boolean
Private RecordSelect As Boolean
Sub Main()
Call HouseKeeping()
Do While Not BallFile.EndOfData
Call ProcessRecords()
Loop
Call EndofJob()
End Sub
Private Sub HouseKeeping()
Call SetDelimiterFile()
Call ReadFile()
End Sub
Private Sub ProcessRecords()
Call SelectRecord()
'If RecordSelect Then
Call DetailCalc()
' Call Accumlations()
Call WriteDetailLine()
'End If
ReadFile()
End Sub
Private Sub EndofJob()
'Call SummaryCalc()
'Call OutputTotalAvg()
Call CloseFile()
End Sub
Private Sub SetDelimiterFile()
BallFile.TextFieldType = FileIO.FieldType.Delimited
BallFile.SetDelimiters(",")
End Sub
Private Sub ReadFile()
Try
CurrentRecord = BallFile.ReadFields()
If CurrentRecord.Length <> 5 Then
Console.WriteLine("Line " & Join(CurrentRecord, ""))
Else
ItemNum = CurrentRecord(0)
ItemDescrip = CurrentRecord(1)
WholeSale = CurrentRecord(2)
MarkupCode = CurrentRecord(3)
AmtSold = CurrentRecord(4)
End If
Catch ex As Exception
Console.WriteLine(ex)
End Try
End Sub
Private Sub SelectRecord()
RecordSelect = False
If BallNum = 1 Then
'Or BallNum = 3 Or BallNum = 5 Then
RecordSelect = True
End If
End Sub
Private Sub DetailCalc()
'TotalPoints = Test1 + Test2 + Test3
' Call DetermineTestPointsByClassTime()
' StudentAvg = (TotalPoints / (ClassPoints * 3))
' Call DetermineGrade()
End Sub
Private Sub DetermineTestPointsByClassTime()
Select Case ItemNum
Case Is = 1
BallNum = BALL_CODE_1
Case Is = 2
BallNum = BALL_CODE_2
Case Is = 3
BallNum = BALL_CODE_3
Case Is = 4
BallNum = BALL_CODE_4
Case Is = 5
BallNum = BALL_CODE_5
Case Else
BallNum = BALL_CODE_6
End Select
End Sub
'Private Sub DetermineGrade()
' Select Case StudentAvg
' Case Is >= 0.9
' Grade = "A"
' Case Is >= 0.8
' Grade = "B"
' Case Is >= 0.7
' Grade = "C"
' Case Is >= 0.6
' Grade = "D"
' Case Else
' Grade = "E"
' End Select
'End Sub
'Private Sub Accumlations()
' TotalNumStudents += 1
' TotalStudentAvg += StudentAvg
'End Sub
Private Sub WriteDetailLine()
If LineCounter > PageSize Then
Call WriteHeaders()
End If
Console.WriteLine(ItemNum.ToString.PadRight(4) & Space(2) & ItemDescrip.ToString.PadLeft(8) & Space(2) & WholeSale.ToString.PadLeft(5) & Space(4) & MarkupCode.ToString.PadLeft(1) & Space(31) & AmtSold.ToString.PadLeft(2) &
Space(3) & BallNum.ToString.PadLeft(3))
' Console.WriteLine(Space(1) & StudentName.PadRight(10) & Space(2) & ClassTime.PadLeft(4) & Space(5) & Test1.ToString().PadLeft(3) & Space(5) & Test2.ToString().PadLeft(3) & Space(5) &
' Test3.ToString().PadLeft(3) & Space(6) & TotalPoints.ToString().PadLeft(3) & Space(6) & StudentAvg.ToString("P0").PadLeft(5) & Space(5) & Grade)
LineCounter += 1
End Sub
Private Sub WriteHeaders()
Console.WriteLine()
Console.WriteLine(Space(6) & "page" & PageNum.ToString().PadLeft(3) & Space(15) & "Sales And Profit Report For")
Console.WriteLine(Space(35) & "Throw It, Inc.")
Console.WriteLine(Space(35) & "By Bryan Hendley")
Console.WriteLine()
Console.WriteLine("Item Desc" & Space(5) & "WhlSale" & Space(2) & "--Markup--" & Space(3) & "Retail" & Space(4) & "Discount" & Space(3) & "Qty" & Space(2) & "Discnt" & Space(6) & "Total")
Console.WriteLine(Space(1) & "Num" & Space(12) & "Price" & Space(2) & "Code" & Space(3) & "Amt" & Space(4) & "Price" & Space(4) & "%" & Space(4) & "Amt" & Space(3) & "Sld" & Space(3) & "Price" & Space(3) &
Space(5) & "Due" & Space(3) & "Profit")
Console.WriteLine()
LineCounter = 1
PageNum += 1
End Sub
' Private Sub SummaryCalc()
' FinalAvg = TotalStudentAvg / TotalNumStudents
' End Sub
' Private Sub OutputTotalAvg()
' Console.WriteLine()
' Console.WriteLine(Space(5) & "Total Number of students processed: " & TotalNumStudents.ToString.PadLeft(7))
' Console.WriteLine(Space(26) & "Final Average: " & FinalAvg.ToString("P0").PadLeft(7))
' End Sub
Private Sub CloseFile()
Console.WriteLine()
Console.WriteLine()
Console.Write("Press ENTER to Close OutPut Window")
Console.ReadLine()
BallFile.Close()
End Sub
End Module

Saving a table in VisualBasic 2010 to a .txt file

I am looking to get the table that is generated at the end of the program below have the option to be saved into a .txt so that it can be looked back to at a later date but am struggling to get this to happen.
Module Module1
Dim kTick As Integer
Dim kName(64) As String
Dim kHours(64) As Integer
Dim kHoursPay(64) As Integer
Dim kGross(64) As Integer
Dim kTax As Integer = 20
Dim kNet(64) As Integer
Dim kTotal As Integer
Dim kAverage As Integer
Sub Main()
'Assigning kTick (Number of employee's)
Assign()
'Imputting the data
Entry()
'Calculating kGross, kTax, kNet and kTotal
Print()
End Sub
Sub Assign()
Console.ForegroundColor = ConsoleColor.Gray
Console.WriteLine("Please enter the total amount of employee's:")
Console.ForegroundColor = ConsoleColor.White
kTick = Console.ReadLine()
Console.Clear()
End Sub
Sub Entry()
For kCounter = 1 To kTick
Console.ForegroundColor = ConsoleColor.DarkGray
Console.WriteLine("Employee " & kCounter)
Console.ForegroundColor = ConsoleColor.Gray
Console.WriteLine("Please enter the employee name below:")
Console.ForegroundColor = ConsoleColor.White
kName(kCounter) = Console.ReadLine()
Do
Console.ForegroundColor = ConsoleColor.Gray
Console.WriteLine("Please enter the employees total hours worked below:")
Console.ForegroundColor = ConsoleColor.White
kHours(kCounter) = Console.ReadLine()
Loop Until kHours(kCounter) >= 0 And kHours(kCounter) <= 60
Do
Console.ForegroundColor = ConsoleColor.Gray
Console.WriteLine("Please enter the employees Hourly Pay below:")
Console.ForegroundColor = ConsoleColor.White
kHoursPay(kCounter) = Console.ReadLine()
Loop Until kHoursPay(kCounter) >= 6 And kHoursPay(kCounter) <= 250
Console.Clear()
Next
End Sub
Sub Print()
For kCounter = 1 To kTick
kGross(kCounter) = kHours(kCounter) * kHoursPay(kCounter)
Next
For kCounter = 1 To kTick
kNet(kCounter) = (kGross(kCounter) / 10) * 8
Next
For kCounter = 1 To kTick
kTotal = kTotal + kHours(kCounter)
Next
kAverage = kTotal / kTick
Console.ForegroundColor = ConsoleColor.Gray
Console.WriteLine("Name" & vbTab & "Hours" & vbTab & "Hourly Rate" & vbTab & "Gross Pay" & vbTab & "Tax" & vbTab & "Net Pay")
Console.ForegroundColor = ConsoleColor.White
For kCounter = 1 To kTick
Console.WriteLine(kName(kCounter) & vbTab & kHours(kCounter) & vbTab & "£" & kHoursPay(kCounter) & vbTab & vbTab & "£" & kGross(kCounter) & vbTab & vbTab & kTax & "%" & vbTab & "£" & kNet(kCounter))
Next
Console.ForegroundColor = ConsoleColor.Gray
Console.WriteLine("Total hours worked: " & kTotal)
Console.WriteLine("Total average hours worked: " & kAverage)
Console.WriteLine("Total number of employees: " & kTick)
Console.ReadLine()
Save()
End Sub
Sub Save()
End Sub
End Module
I am trying to get the code in the Save subroutine any help will be appreciated!
Thanks Kai
One note: you should not Save from Print since both are unrelated by nature. So you may want to print without saving or save without printing to the console.
A simple approach is using the File class, for example by using File.WriteAllText(path) or File.WriteAllLines(path). Therefore you need to store the text you want to output(to the console and the file) somewhere. For example in a List(Of String) variable.
You are looking for StreamWriter class. It has Write and WriteLine methods that can help you. It works in a same way as Console.WriteLine you are using.