Thursday, 15 August 2013

Translate from VBA to VB.Net Workbook and FileDialog

Translate from VBA to VB.Net Workbook and FileDialog

I have been working on translating the code below from VBA to VB.Net. I am
about 90% of the way there but I am stuck on 3 issues.
First, In VBA I used the Application.GetOpenFilename to open a file dialog
from within my code, I can't seem to get that done on VB.
Second, I am trying to export a sheet and copy the data onto a sheet on my
workbook. I use the following line of code:
With Globals.ThisWorkbook.Application.ActiveWorkbook.Open(strImportFile)
.Worksheets(1).Cells.Copy
Workbooks(strSourceFile).Worksheets(sDestSheet).Range("A1")
.Close(savechanges:=False)
Unfortunately, the middle line is not working the Workbooks gives me an
error that it cannot be used as type.
And finally, I am trying to get the Application ScreenUpdating, but that
also fails. Here is the rest of my code:
Imports Microsoft.Office.Interop.Excel
Module adminModule
Function GetImportFile(Index As Long) As String
'This function is used in the import_Module to name all of the files
'that will be imported to the template. The function is primarily
used by
'Sub import_OC_Data
Select Case Index
Case 1 : GetImportFile = "byemployee.csv"
Case 2 : GetImportFile = "byposition.csv"
Case 3 : GetImportFile = "statusreport.xls"
Case 4 : GetImportFile = "bydepartment.csv"
End Select
Return ""
End Function
Function GetDestSheet(Index As Long) As String
'This function is used in the import_Module to name all of the sheets
'where the files will be imported to in template.The function is
primarily used by
'Sub import_OC_Data
Select Case Index
Case 1 : GetDestSheet = "byDepartment"
Case 2 : GetDestSheet = "byPosition"
Case 3 : GetDestSheet = "statusReport"
Case 4 : GetDestSheet = "byDepartment"
End Select
Return ""
End Function
Sub importRawData()
Dim xlWBPath As String =
Globals.ThisWorkbook.Application.ActiveWorkbook.Path
Dim n As Long
Dim strSourceFile As String
Dim strImportFile As String
Dim sDestSheet As String
Dim strTitle As String = "Verify Source File"
Dim strPrompt As String = " source file does not exist." &
vbNewLine & "Press OK to browse for the file or Cancel to quit"
Dim strAlert As String = ("You have not selected a workbook." &
vbNewLine & "Press Retry to select a workbook or Cancel to exit
program")
Dim strVmbProceedResults As String = ("Procedure Canceled. Your
workbook will now close")
Dim vmbContinue As MsgBoxResult
Dim vmbProceed As MsgBoxResult
strSourceFile = Globals.ThisWorkbook.Application.ActiveWorkbook.Na
For n = 1 To 4 Step 1
strImportFile = xlWBPath & GetImportFile(n)
sDestSheet = GetDestSheet(n)
If Len(Dir(strImportFile)) > 0 Then
With
Globals.ThisWorkbook.Application.ActiveWorkbook.Open(strImportFile)
.Worksheets(1).Cells.Copy
Workbooks(strSourceFile).Worksheets(sDestSheet).Range("A1")
.Close(savechanges:=False)
End With
Else
vmbProceed = MsgBox(strImportFile & strPrompt, vbOKCancel
+ vbQuestion, strTitle)
If vmbProceed = vbCancel Then
vmbProceed = MsgBox(strVmbProceedResults, vbOKOnly +
vbCritical)
Globals.ThisWorkbook.Close(saveChanges:=False)
Exit Sub
Else
strImportFile = Application.GetOpenFilename("Excel
Files (*.xls;*.xlsx; *.xlsm; *.csv), *.xls; *.csv;
*.xlsx; *.xlsm")
If strImportFile = "False" Then
Application.ScreenUpdating = True
vmbContinue = MsgBox(strAlert, vbRetryCancel +
vbCritical, "No Workbook Selected")
If vmbContinue = vbCancel Then
Globals.ThisWorkbook.Close(saveChanges:=False)
Exit Sub
Else
strImportFile = Application.GetOpenFilename("Excel
Files (*.xls;*.xlsx; *.xlsm; *.csv), *.xls; *.csv;
*.xlsx; *.xlsm")
Globals.ThisWorkbook.Application.ActiveWorkbook.Open(Filename:=strImportFile)
With
Globals.ThisWorkbook.Application.ActiveWorkbook.Open(strImportFile)
.Worksheets(1).Cells.Copy
Workbooks(strSourceFile).Worksheets(sDestSheet).Range("A1")
.Close(saveChanges:=False)
End With
End If
On Error GoTo exit_
Application.ScreenUpdating = False
Globals.ThisWorkbook.Application.ActiveWorkbook.Open(Filename:=strImportFile)
With
Globals.ThisWorkbook.Application.ActiveWorkbook.Openn(strImportFile)
.Worksheets(1).Cells.Copy
Workbooks(strSourceFile).Worksheets(sDestSheet).Range("A1")
.Close(savechanges:=False)
End With
exit_:
Application.ScreenUpdating = True
If Err() Then MsgBox(Err.Description, vbCritical,
"Error")
End If
End If
Next n
End Sub
End Module

No comments:

Post a Comment