Private Sub Button3_Click(sender As System.Object, e As System.EventArgs) Handles Button3.Click
Dim datenow As String = DateTime.Now.ToString("MMM dd")
xlApp = New Excel.Application
xlbook = xlApp.Workbooks.Open(xlspath)
xlsheet1 = xlbook.Worksheets("Sheet1")
xlbook.Sheets("Sheet1").Name = "Summary"
xlbook.Sheets("Sheet2").delete()
xlbook.Sheets("Sheet3").delete()
With xlsheet1
.Columns("K:J").delete()
.Columns("A:A").delete()
.Columns("B:B").insert()
.Cells(1, 1).Copy()
.Cells(1, 2).PasteSpecial(Paste:=Excel.Constants.xlFormats, Operation:=Excel.Constants.xlNone, SkipBlanks:=False, Transpose:=False)
.Cells(1, 2) = "Pic"
.Cells(1, 8) = "APP"
.Cells(1, 9) = "APP Version"
End With
Dim lastsheet = "Summary"
For x = 2 To xlsheet1.Rows.Count
If xlsheet1.Cells(x, 1).value = Nothing Then
Exit For
Else
xlbook.Worksheets.Add(After:=xlbook.Worksheets(lastsheet))
lastsheet = CStr(xlsheet1.Cells(x, 1).value)
xlbook.Sheets(CStr("Sheet" & CStr(x - 1))).Name = lastsheet
For y = 1 To xlsheet1.Columns.Count
If xlsheet1.Cells(1, y).value = Nothing Then
Exit For
Else
xlsheet1.Cells(1, y).Copy()
With xlbook.Sheets(lastsheet)
.cells(1, y).PasteSpecial(Paste:=Excel.Constants.xlFormats, Operation:=Excel.Constants.xlNone, SkipBlanks:=False, Transpose:=False)
.cells(1, y) = xlsheet1.Cells(1, y).value
.cells(2, y) = xlsheet1.Cells(x, y).value
End With
End If
Next
With xlbook.Sheets(lastsheet)
.columns("B:B").delete()
.columns("A:k").HorizontalAlignment = Excel.Constants.xlLeft
.columns("A:k").VerticalAlignment = Excel.Constants.xlTop
.columns("A:k").wraptext = True
.columns("A:k").autofit()
.columns("i:i").columnwidth = 20
.columns("j:j").columnwidth = 60
.columns("K:K").columnwidth = 60
.rows("1:100").autofit()
End With
xlsheet1.Hyperlinks.Add(Anchor:=xlsheet1.Cells(x, 1), Address:="", SubAddress:="'" & lastsheet & "'!A1", TextToDisplay:=(lastsheet))
Dim pix = 100
Dim txt = 215
For Each foundFile As String In My.Computer.FileSystem.GetFiles(ComboBox1.SelectedItem, FileIO.SearchOption.SearchTopLevelOnly, "*" & lastsheet & "*")
Dim extension = Path.GetExtension(foundFile).ToLower.ToString
If extension = ".log" Or extension = ".txt" Then
xlbook.Sheets(lastsheet).OLEObjects.Add(FileName:=foundFile, Link:=False, DisplayAsIcon:=True, IconFileName:=Environment.GetFolderPath(Environment.SpecialFolder.Windows) & "\Notepad.exe", IconIndex:=0, IconLabel:=Path.GetFileName(foundFile), Left:=265, Top:=txt, Width:=75, Height:=75)
txt += 80
xlsheet1.Cells(x, 2) = xlsheet1.Cells(x, 2).value + "X"
ElseIf extension = ".png" Or extension = ".jpg" Or extension = ".jpeg" Or extension = ".gif" Then
xlbook.Sheets(lastsheet).Shapes.AddPicture(foundFile, Microsoft.Office.Core.MsoTriState.msoCTrue, Microsoft.Office.Core.MsoTriState.msoCTrue, 25, pix, 215, 350)
pix += 350
xlsheet1.Cells(x, 2) = xlsheet1.Cells(x, 2).value + "X"
End If
Next
End If
Next
With xlsheet1
.Columns("D:D").delete()
.Columns("J:L").delete()
.Columns("C:C").delete()
.Columns("A:K").autofit()
.Columns("A:G").HorizontalAlignment = Excel.Constants.xlCenter
.Cells(1, 8).HorizontalAlignment = Excel.Constants.xlCenter
.Columns("A:H").VerticalAlignment = Excel.Constants.xlTop
End With
Dim sheet As Excel.Worksheet
Dim title = xlsheet1.Cells(2, 6).value & "v" & xlsheet1.Cells(2, 7).value & " Defects " & xlsheet1.Cells(2, 3).value & " " & datenow & ".xls"
Dim header = "&20 &B" & xlsheet1.Cells(2, 6).value & " " & xlsheet1.Cells(2, 7).value
For Each sheet In xlbook.Worksheets
sheet.PageSetup.Orientation = Excel.XlPageOrientation.xlLandscape
sheet.PageSetup.LeftHeader = "&D &T"
sheet.PageSetup.CenterHeader = header.ToString
sheet.PageSetup.LeftFooter = title.ToString
sheet.PageSetup.RightFooter = "&P/&N"
sheet.PageSetup.Zoom = False
sheet.PageSetup.FitToPagesTall = 2
sheet.PageSetup.FitToPagesWide = 1
Next
xlsheet1.Activate()
xlbook.SaveAs(Environment.GetFolderPath(Environment.SpecialFolder.DesktopDirectory) & "\" & title.ToString)
CloseExcel()
End Sub