-
Sep 9th, 2014, 06:54 PM
#1
Thread Starter
New Member
VB.NET Automatic Excel Reading & Writing
Hi Guys,
im new here and i directly have to ask you all for help, gladly these days platforms like this one excist and i hope i can maybe give back some help in the future.
At the moment i want to create a small application where the user can choose to input a specific type of excel file which kind of looks like this:
Code:
A - B - C - D
1 01.04.2014
2 01.04.2014
3 02.04.2014
4 03.04.2014
Im trying to open this file in VB.NET and loop through all rows of Range A, when it contains a valid date i want it to create a new excel file, create a new sheet within that excel file with our date as the name of that sheet and until the date stays the same (i.e. 01.04.2014 over 5 rows) write information to the sheet, when the date changes, create a new sheet and so on.
The Problem is that i have no idea how to check the cells in the way i need it.
This is what i have so far:
Code:
Imports Microsoft.Office.Interop.Excel
Imports Microsoft.Office.Interop
Public Class EasyResults
Private Sub Search_Click(sender As Object, e As EventArgs) Handles Search.Click
Using FileDialog As New OpenFileDialog
FileDialog.Title = "Select Pokerstars Audit"
FileDialog.Filter = "Microsoft Excel|*.xl*|All Files|*.*"
If FileDialog.ShowDialog() = DialogResult.OK Then
PathToExcelFile.Text = FileDialog.FileName
End If
End Using
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim xlApp As New Excel.Application
Dim xlWb As Excel.Workbook
Dim xlsheet As Excel.Worksheet
Dim lRow As Long = 0
With xlApp
.Visible = False
'~~> Open workbook
xlWb = .Workbooks.Open(PathToExcelFile.Text)
'~~> Set it to the relevant sheet
xlsheet = xlWb.Sheets("Playing history audit")
'~~> Get last Row of Document
With xlsheet
lRow = .Range("A" & .Rows.Count).End(Excel.XlDirection.xlUp).Row
End With
Dim i As Integer = 4
'~~> Loop through all Rows of the Excel File
Do While i <= lRow
MsgBox(xlsheet.Cells(i, 1).Value.ToString.Substring(0, 10))
i = i + 1
Loop
' Zeile 4 Spalte 1
' MsgBox(xlsheet.Cells(4, 1).Value.ToString, MsgBoxStyle.OkOnly)
'~~> Close workbook and quit Excel
xlWb.Close(False)
xlApp.Quit()
'~~> Clean Up
releaseObject(xlsheet)
releaseObject(xlWb)
releaseObject(xlApp)
End With
End Sub
Private Sub releaseObject(ByVal obj As Object)
Try
System.Runtime.InteropServices.Marshal.ReleaseComObject(obj)
obj = Nothing
Catch ex As Exception
obj = Nothing
Finally
GC.Collect()
End Try
End Sub
End Class
Maybe one of you guys has an idea how i could do this, any help would be very much appreciated!
Thanks in advance,
Enter_Sandman
-
Sep 10th, 2014, 09:31 AM
#2
Re: VB.NET Automatic Excel Reading & Writing
are the rows in the input sheet sorted by the date column? if yes this makes it alot easier as you just have to compare the current value against the prev value to determine if you need to create a new sheet.
something like this may work (bit pseudocode and untested)
Code:
dim dtPrevious as date
dim wbCurrent as workbook
dim cllTarget as range
Do While i <= lRow
if dtPrevious is nothing orelse dtPrevious<> cdate(xlsheet.Cells(i, 1)) then
'time for a new workbook
if not dtPrevious is nothing then
'save prev workbook
wbcurrent.save dtPrevious.tostring & ".xlsx"
wbCurrent.close
end if
wbCurrent=xlApp.Workbooks.add
wbCurrent.sheets(1).name=xlsheet.Cells(i, 1)
cllTarget=wbCurrent.sheets(1).range("A1")
dtPrevious=cdate(xlsheet.Cells(i, 1))
end if
'write your info to wbCurrent.Sheets(1) here, you have not told us what kind of infor you want. i guess its copying something from the input row
'so i introduced cllTarget for that use
cllTarget.Value=xlsheet.Cells(i, 1)
cllTarget =cllTarget.Offset(1,0) 'set to next row in the target sheet
i = i + 1
Loop
-
Sep 10th, 2014, 01:49 PM
#3
Thread Starter
New Member
Re: VB.NET Automatic Excel Reading & Writing
Hey, thank you for your quick reply.
The Rows are indeed sorted by the date column!
This is what the sheet that i take information from looks like:
Basicly what i want to do is a list of the Tournaments played for a specific date and how much total buy-in and winnings were generated that day.
Col 1 is Date/Time where i get just the date from using substring.
Col 2 is Action (i.e. Tournament Registration, Tournament Rebuy, Tournament Addon or Tournament Unregistration)
Col 3 is the specific Tournament ID (unique)
Col 4 is the Tournament Name / Type
Col 5 obviously the account currency
Col 6 is the Tournament Buyin
So i need to check for the date and then check for Tournament Registration - get the Name of the Tournament and its Buyin and copy it to the new excel file where a sheet should be created for every single day played.
Im sorry if i was a bit unspecific in my first post and im definitely gonna try your code now
If you have any more ideas feel free to let me know!
Greetings,
Enter_Sandman
Last edited by Enter_Sandman; Sep 10th, 2014 at 02:41 PM.
-
Sep 15th, 2014, 10:31 AM
#4
Thread Starter
New Member
Re: VB.NET Automatic Excel Reading & Writing
Just wanted to check back real quick and let you guys see what i have done so far (which is working as it should):
Code:
Private Sub get_results_Click(sender As Object, e As EventArgs) Handles get_results.Click
' ### First File Process ### '
Dim oExcel As Excel.Application
Dim oBook As Excel.Workbook
Dim oSheet As Excel.Worksheet
Dim cllTarget As Excel.Range = Nothing
Dim AuditFile As Excel.Workbook
Dim AuditSheet As Excel.Worksheet
' Start a new workbook in Excel.
oExcel = CreateObject("Excel.Application")
oBook = oExcel.Workbooks.Add
' Open Excel File
AuditFile = oExcel.Workbooks.Open(PathToExcelFile.Text)
AuditSheet = AuditFile.Sheets("Playing history audit")
' Save new File to:
Dim sSampleFolder As String = "C:\"
' Start Reading Data in row:
Dim i As Integer = 4
Dim lRow As Long = 0
' set dtPrevious to 1st Date
Dim dtPrevious As String = AuditSheet.Cells(i, 1).Value.ToString.Substring(0, 10)
Dim b As Integer = 5
Dim newWorksheet As Excel.Worksheet
Dim WrkShtCount As Integer
Dim RowCount As Integer = 7
Dim StrCurrency As System.Decimal
Dim StartDate
Dim EndDate
Dim TourneyCount As Integer = 0
Dim OldDate
' Get last row of Audit File
lRow = AuditSheet.Range("A" & AuditSheet.Rows.Count).End(Excel.XlDirection.xlUp).Row
' Delete all worksheets except for 1
WrkShtCount = oBook.Worksheets.Count
If oBook.Worksheets.Count >= 1 Then
Do Until WrkShtCount = 1
oBook.Worksheets(WrkShtCount).Delete()
WrkShtCount = WrkShtCount - 1
Loop
End If
oSheet = oBook.Worksheets(1)
oSheet.Name = dtPrevious
ProgressBar1.Minimum = 0
ProgressBar1.Maximum = lRow
oBook.Colors(1) = RGB(0, 100, 0)
oBook.Colors(2) = RGB(178, 34, 34)
oBook.Colors(3) = RGB(216, 216, 216)
oBook.Colors(4) = RGB(255, 255, 255)
If Start_Bankroll.Text <> "" Then
oSheet.Range("B2").Value = Start_Bankroll.Text
End If
Do While i <= lRow
ProgressBar1.Visible = True
ProgressBar1.Value = i
' Setup Excel Sheet
oSheet.Range("A:F").Font.Name = "Arial"
oSheet.Range("A:F").Font.Size = "10"
oSheet.Range("A1:B1").Cells.MergeCells = True
oSheet.Range("A1:B1").Value = "Bankroll"
oSheet.Range("A2").Value = "Start"
oSheet.Range("A3").Value = "Ende"
oSheet.Range("D2:I2").Font.Italic = True
oSheet.Range("D2:I2").Font.Bold = True
oSheet.Range("D2").Value = "Winnings $"
oSheet.Range("E2").Value = "Turniere #"
oSheet.Range("F2").Value = "Average Buyin $"
oSheet.Range("G2").Value = "Buyin $"
oSheet.Range("I2").Value = "Cashes $"
oSheet.Cells.Range("B3").Interior.ColorIndex = 3
oSheet.Cells.Range("D3:E3").Interior.ColorIndex = 3
oSheet.Cells.Range("F3").Interior.ColorIndex = 3
oSheet.Cells.Range("G3").Interior.ColorIndex = 3
oSheet.Cells.Range("I3").Interior.ColorIndex = 3
oSheet.Range("B5:I5").Font.Italic = True
oSheet.Range("B5").Value = "Seite"
oSheet.Range("D5").Value = "Datum"
oSheet.Range("E5").Value = "Turnier"
oSheet.Range("G5").Value = "Buyin $"
oSheet.Range("H5").Value = "Buyin €"
oSheet.Range("I5").Value = "Cashes $"
oSheet.Range("B7").Value = "Pokerstars.EU"
oSheet.Cells.Range("B7").Interior.Color = RGB(0, 0, 0)
oSheet.Cells.Range("B7").Font.ColorIndex = 4
oSheet.Cells.Range("B7").Font.Bold = True
oSheet.Cells.Range("B7").HorizontalAlignment = Excel.Constants.xlCenter
oSheet.Range("A1:D1").Font.Bold = True
oSheet.Range("A1").HorizontalAlignment = Excel.Constants.xlCenter
oSheet.Range("B5").HorizontalAlignment = Excel.Constants.xlCenter
oSheet.Range("D5").HorizontalAlignment = Excel.Constants.xlCenter
oSheet.Range("E5").HorizontalAlignment = Excel.Constants.xlCenter
oSheet.Range("G5:I5").HorizontalAlignment = Excel.Constants.xlCenter
oSheet.Range("D2:I2").HorizontalAlignment = Excel.Constants.xlCenter
oSheet.Range("I3").Formula = "=SUM(I7:I65536)"
oSheet.Range("G3").Formula = "=SUM(G7:G65536)"
oSheet.Range("D3").Formula = "=SUM(I3-G3)"
oSheet.Range("F3").Formula = "=SUM(G3/E3)"
oSheet.Cells.Range("A1:B1").ColumnWidth = "15"
oSheet.Cells.Range("C3").ColumnWidth = "0.5"
oSheet.Cells.Range("E5").ColumnWidth = "100"
If dtPrevious = AuditSheet.Cells(i, 1).Value.ToString.Substring(0, 10) Then
Debug.WriteLine(dtPrevious & " = " & AuditSheet.Cells(i, 1).Value.ToString.Substring(0, 10))
Debug.WriteLine("Writing Data to Sheet if Cell (i,2) is = 'Turnieranmeldung'...")
' Wenn der Inhalt von Zelle (i, 2) Turnieranmeldung ist und wenn
If AuditSheet.Cells(i, 2).Value.ToString = "Turnieranmeldung" Or AuditSheet.Cells(i, 2).Value.ToString = "Tournament Registration" And dtPrevious = AuditSheet.Cells(i, 1).Value.ToString.Substring(0, 10) Then
Debug.WriteLine(AuditSheet.Cells(i, 2).Value.ToString & " = Turnieranmeldung")
oSheet.Cells(RowCount, 4).Value = dtPrevious
oSheet.Cells(RowCount, 5).Value = AuditSheet.Cells(i, 4).Value.ToString & " Turnier Id: " & AuditSheet.Cells(i, 3).Value.ToString
oSheet.Cells(RowCount, 7).Value = AuditSheet.Cells(i, 6).Value.ToString
StrCurrency = oSheet.Cells(RowCount, 7).Value
oSheet.Cells(RowCount, 7).Value = Math.Abs(StrCurrency)
oSheet.Range("G7:G" & RowCount).Cells.Font.ColorIndex = 2
oSheet.Range("H7:H" & RowCount).Cells.Font.ColorIndex = 2
oSheet.Range("I7:I" & RowCount).Cells.Font.ColorIndex = 1
TourneyCount = TourneyCount + 1
RowCount = RowCount + 1
oSheet.Range("E3").Value = TourneyCount
oSheet.Range("A:I").EntireColumn.AutoFit()
ElseIf AuditSheet.Cells(i, 2).Value.ToString = "Turnier - Rebuy" Or AuditSheet.Cells(i, 2).Value.ToString = "Tournament Rebuy" And dtPrevious = AuditSheet.Cells(i, 1).Value.ToString.Substring(0, 10) Then
Debug.WriteLine(AuditSheet.Cells(i, 2).Value.ToString & " = Turnier - Rebuy")
oSheet.Cells(RowCount, 4).Value = dtPrevious
oSheet.Cells(RowCount, 5).Value = "Rebuy @ " & AuditSheet.Cells(i, 4).Value.ToString
oSheet.Cells(RowCount, 7).Value = AuditSheet.Cells(i, 6).Value.ToString
StrCurrency = oSheet.Cells(RowCount, 7).Value
oSheet.Cells(RowCount, 7).Value = Math.Abs(StrCurrency)
oSheet.Range("G7:G" & RowCount).Cells.Font.ColorIndex = 2
oSheet.Range("H7:H" & RowCount).Cells.Font.ColorIndex = 2
oSheet.Range("I7:I" & RowCount).Cells.Font.ColorIndex = 1
RowCount = RowCount + 1
oSheet.Range("A:I").EntireColumn.AutoFit()
ElseIf AuditSheet.Cells(i, 2).Value.ToString = "Turnier - Addon" Or AuditSheet.Cells(i, 2).Value.ToString = "Tournament Addon" And dtPrevious = AuditSheet.Cells(i, 1).Value.ToString.Substring(0, 10) Then
Debug.WriteLine(AuditSheet.Cells(i, 2).Value.ToString & " = Turnier - Addon")
oSheet.Cells(RowCount, 4).Value = dtPrevious
oSheet.Cells(RowCount, 5).Value = "Addon @ " & AuditSheet.Cells(i, 4).Value.ToString
oSheet.Cells(RowCount, 7).Value = AuditSheet.Cells(i, 6).Value.ToString
StrCurrency = oSheet.Cells(RowCount, 7).Value
oSheet.Cells(RowCount, 7).Value = Math.Abs(StrCurrency)
oSheet.Range("G7:G" & RowCount).Cells.Font.ColorIndex = 2
oSheet.Range("H7:H" & RowCount).Cells.Font.ColorIndex = 2
oSheet.Range("I7:I" & RowCount).Cells.Font.ColorIndex = 1
RowCount = RowCount + 1
oSheet.Range("A:I").EntireColumn.AutoFit()
ElseIf AuditSheet.Cells(i, 2).Value.ToString = "Prämie: Knockout Bounty" Or AuditSheet.Cells(i, 2).Value.ToString = "Reward: Knockout Bounty" And dtPrevious = AuditSheet.Cells(i, 1).Value.ToString.Substring(0, 10) Then
Debug.WriteLine(AuditSheet.Cells(i, 2).Value.ToString & " = Knockout Bounty")
oSheet.Cells(RowCount, 4).Value = dtPrevious
oSheet.Cells(RowCount, 5).Value = "Knockout Bounty @ Turnier Id: " & AuditSheet.Cells(i, 3).Value.ToString
oSheet.Cells(RowCount, 6).Value = " "
oSheet.Cells(RowCount, 9).Value = AuditSheet.Cells(i, 6).Value.ToString
StrCurrency = oSheet.Cells(RowCount, 9).Value
oSheet.Cells(RowCount, 9).Value = Math.Abs(StrCurrency)
oSheet.Range("G7:G" & RowCount).Cells.Font.ColorIndex = 2
oSheet.Range("H7:H" & RowCount).Cells.Font.ColorIndex = 2
oSheet.Range("I7:I" & RowCount).Cells.Font.ColorIndex = 1
RowCount = RowCount + 1
oSheet.Range("A:I").EntireColumn.AutoFit()
ElseIf AuditSheet.Cells(i, 2).Value.ToString = "Turnierabmeldung" Or AuditSheet.Cells(i, 2).Value.ToString = "Tournament Unregistration" And dtPrevious = AuditSheet.Cells(i, 1).Value.ToString.Substring(0, 10) Then
Debug.WriteLine(AuditSheet.Cells(i, 2).Value.ToString & " = Turnierabmeldung")
oSheet.Cells(RowCount, 4).Value = dtPrevious
oSheet.Cells(RowCount, 5).Value = "Turnier abgemeldet ->" & AuditSheet.Cells(i, 4).Value.ToString
oSheet.Cells(RowCount, 6).Value = " "
oSheet.Cells(RowCount, 9).Value = AuditSheet.Cells(i, 6).Value.ToString
StrCurrency = oSheet.Cells(RowCount, 9).Value
oSheet.Cells(RowCount, 9).Value = Math.Abs(StrCurrency)
oSheet.Range("G7:G" & RowCount).Cells.Font.ColorIndex = 2
oSheet.Range("H7:H" & RowCount).Cells.Font.ColorIndex = 2
oSheet.Range("I7:I" & RowCount).Cells.Font.ColorIndex = 1
TourneyCount = TourneyCount - 1
RowCount = RowCount + 1
oSheet.Range("A:I").EntireColumn.AutoFit()
ElseIf AuditSheet.Cells(i, 2).Value.ToString = "Turnier gewonnen" Or AuditSheet.Cells(i, 2).Value.ToString = "Tournament Won" And dtPrevious = AuditSheet.Cells(i, 1).Value.ToString.Substring(0, 10) Then
Debug.WriteLine(AuditSheet.Cells(i, 2).Value.ToString & " = Cash")
oSheet.Cells(RowCount, 4).Value = dtPrevious
oSheet.Cells(RowCount, 5).Value = "Cash @ " & AuditSheet.Cells(i, 4).Value.ToString
oSheet.Cells(RowCount, 6).Value = " "
oSheet.Cells(RowCount, 9).Value = AuditSheet.Cells(i, 6).Value.ToString
StrCurrency = oSheet.Cells(RowCount, 9).Value
oSheet.Cells(RowCount, 9).Value = Math.Abs(StrCurrency)
oSheet.Range("G7:G" & RowCount).Cells.Font.ColorIndex = 2
oSheet.Range("H7:H" & RowCount).Cells.Font.ColorIndex = 2
oSheet.Range("I7:I" & RowCount).Cells.Font.ColorIndex = 1
RowCount = RowCount + 1
oSheet.Range("A:I").EntireColumn.AutoFit()
End If
oSheet.Range("B3").Formula = "=SUM(B2+D3)"
Else
Debug.WriteLine(dtPrevious & " <> " & AuditSheet.Cells(b, 1).Value.ToString.Substring(0, 10) & " Task: Add New Worksheet with name " & AuditSheet.Cells(b, 1).Value.ToString.Substring(0, 10))
OldDate = dtPrevious
dtPrevious = AuditSheet.Cells(b, 1).Value.ToString.Substring(0, 10)
Debug.WriteLine(dtPrevious & " is now dtPrevious.")
newWorksheet = oBook.Worksheets.Add()
Debug.WriteLine("Worksheet added.")
newWorksheet.Name = dtPrevious
Debug.WriteLine("Worksheet Name added.")
oSheet = oBook.ActiveSheet
Debug.WriteLine("Set new sheet as ActiveSheet done.")
If oBook.Worksheets.Count > 1 Then
oSheet.Range("B2").Formula = "='" & OldDate & "'!B3"
End If
Debug.WriteLine("RowCount = " & RowCount)
RowCount = 7
Debug.WriteLine("RowCount reset to 7 -> " & RowCount)
Debug.WriteLine("TourneyCount = " & TourneyCount)
TourneyCount = 0
Debug.WriteLine("RowCount reset to 0 -> " & TourneyCount)
End If
i = i + 1
b = b + 1
If i <= lRow Then
ProgressBar1.Value = i
End If
If oBook.Worksheets.Count = 1 Then
StartDate = oSheet.Name
End If
Loop
' Delete empty Worksheets if there are any
Call DeleteEmptySheets()
EndDate = oBook.Sheets(1).Name
'Save the Workbook and quit Excel.
oBook.SaveAs(sSampleFolder & "Abrechnung_" & StartDate & "_" & EndDate & ".xls")
oSheet = Nothing
oBook = Nothing
oExcel.Quit()
oExcel = Nothing
GC.Collect()
ProgressBar1.Visible = False
End Sub
Now i would like to do the same thing for a second file but i dont really know how to start there, should i process it at the same time as the first file or is it better to do it after the first one is finished?
Another thing is that my code is pretty long right now, did i do something which is "bad practice" in my code? What should i change?
Greetings,
Enter_Sandman
-
Sep 15th, 2014, 10:35 AM
#5
Thread Starter
New Member
Re: VB.NET Automatic Excel Reading & Writing
This is how the Application will look later, but the .fr part isnt working yet:
-
Sep 16th, 2014, 08:25 AM
#6
Re: VB.NET Automatic Excel Reading & Writing
Hello,
You might consider using OleDb. I have a solution which was done a while ago and added one project for getting last row for a column or set of columns in a sheet. The get last row is the sole automation in the solution so the creation methods are OleDb. If there is code commented out then by all means try with and without comments as it was intended for this.
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|