How to fasten export to excel

 

Public Sub excelexport(ByVal 
lvexcel As ListView)

Dim mcd As New SaveFileDialog

mcd.ShowDialog()

If mcd.FileName = "" Then

Exit Sub

End If

Dim exapp As Object

Dim wsheet As Object

Dim wbook As Object

exapp = CreateObject("excel.application")

wbook = exapp.Workbooks.Add

wsheet = wbook.worksheets(1)

Dim i, j, mrow As Integer

mrow = 1

For i = 0 To 
lvexcel.Columns.Count - 1

If lvexcel.Columns(i).Width > 0 
Then

wsheet.Cells(mrow, i + 1) = lvexcel.Columns(i).Text

wsheet.Cells(mrow, i + 1).Font.bold = True

End If

Next i

For i = 0 To 
lvexcel.Items.Count - 1

mrow = mrow + 1

For j = 0 To 
lvexcel.Items(i).SubItems.Count - 1

If lvexcel.Columns(j).Width > 0 
Then

wsheet.Cells(mrow, j + 1) = lvexcel.Items(i).SubItems(j).Text

End If

Next j

Next i

wsheet.Columns.EntireColumn.AutoFit()

wsheet.Rows.EntireRow.AutoFit()

If mcd.FileName.Contains(".xls") Then

wsheet.SaveAs(mcd.FileName)

wbook.Close()

Else

wsheet.SaveAs(mcd.FileName & ".xls")

wbook.Close()

End If

exapp = Nothing

MsgBox("Report 
Completed")

End Sub