Excel sheet to save in specific folder

[Anonymous]

Hello,

I am trying to get illogic to pull a excel template, fill in specific cells, create a new folder and save the worksheet in the new folder. I have a code that works mostly but it saves the excel sheet in the wrong folder.

I have attached the code below & I'm using inventor 2020.

Dim oDOc As DrawingDocument
name = ThisDoc.FileName (False)
oPath = ThisDoc.Path
oName = "Drawing Review"
oDOc = ThisApplication.ActiveDocument
path_and_name = ThisDoc.PathAndFileName(False)

    'get target folder path from the file's path + DWF
    oFolder = oPath & "\" & oName

  'Check for the DWF folder and create it if it does not exist
    If Not System.IO.Directory.Exists(oFolder) Then
        System.IO.Directory.CreateDirectory(oFolder)
    End If


	Dim oSheet As Sheet
 	oSheet = oDOc.Sheets.Item(1)

	Dim oPartList As PartsList
 	oPartList = oSheet.PartsLists.Item(1)

	Dim oOptions As NameValueMap
	oOptions = ThisApplication.TransientObjects.CreateNameValueMap

myXLS_File = ThisDoc.PathAndFileName(True) & ".xlsx"


'get the Inventor user name from the Inventor Options
myName= ThisApplication.GeneralOptions.UserName


'define Excel Application object
excelApp = CreateObject("Excel.Application")
'set Excel to run visibly, change to false if you want to run it invisibly
excelApp.Visible = False
'suppress prompts (such as the compatibility checker)
excelApp.DisplayAlerts = False


'check for existing file 
If Dir(myXLS_File) <> "" Then
'workbook exists, open it
excelWorkbook = excelApp.Workbooks.Open(myXLS_File)
'set the first sheet active
excelSheet = excelWorkbook.Worksheets(1).activate
Else
'workbook does NOT exist, so create a new one using the default template
'excelWorkbook = excelApp.Workbooks.Add
' or use this syntax to specify a template to use
excelWorkbook =  excelApp.Workbooks.Add	("\\Fig015\cad\0-0-Veritas\Drawing Checklist\Drawing Checklist.xlsm")
End If


'Insert data into Excel.
With excelApp
    .Range("A4").Select
    .ActiveCell.FormulaR1C1 = iProperties.Value("Custom", "Order Number")
	.Range("C4").Select
    .ActiveCell.FormulaR1C1 = iProperties.Value("Custom", "Client Name")
	.Range("F4").Select
    .ActiveCell.FormulaR1C1 = iProperties.Value("Custom", "Project Name")
	.Range("K4").Select
    .ActiveCell.FormulaR1C1 = ThisApplication.GeneralOptions.UserName
.Range("I4").Select
    .ActiveCell.FormulaR1C1 = iProperties.Value("Custom", "Project Team")
End With   


'set all of the columns to autofit
'excelApp.Columns.AutoFit   
'save the file
excelWorkbook.SaveAs (myXLS_File)


''close the workbook and the Excel Application
''uncomment if you want to close the xls file at the end
excelWorkbook.Close
excelApp.Quit
excelApp = Nothing

[HideoYamada]

Hello,

Huum, I run this code and got a excel file at the directory where ThisDoc exists.

myXLS_File = ThisDoc.PathAndFileName(False) & ".xlsx"

excelApp = CreateObject("Excel.Application")
excelApp.Visible = True

excelWorkbook =  excelApp.Workbooks.Add	("C:\template.xlsx")

With excelApp
    .Range("A1").Formula = myXLS_File
End With   

excelWorkbook.SaveAs (myXLS_File)

excelWorkbook.Close
excelApp.Quit
excelApp = Nothing

Buy the way,

myXLS_File = ThisDoc.PathAndFileName(True) & ".xlsx"

should be

myXLS_File = ThisDoc.PathAndFileName(False) & ".xlsx"

 , I think.

=====

Freeradical

 Hideo Yamada

[Anonymous]

I need the excel sheet to save in the folder that it creates.

[Sergio.D.Suárez · Accepted solution]

Hi, I have no way to test the code at this time. Try these changes to your original lines.

Dim oDOc As DrawingDocument = ThisDoc.Document

oPath = ThisDoc.Path
oName = "Drawing Review"
'get target folder path from the file's path + DWF
oFolder = oPath & "\" & oName

'Check for the DWF folder and create it if it does not exist
If Not System.IO.Directory.Exists(oFolder) Then
    System.IO.Directory.CreateDirectory(oFolder)
End If

oFileName = oDOc.DisplayName
oFileName = Left(oFileName, (InStrRev(oFileName, ".", - 1, vbTextCompare) - 1))

myXLS_File = oFolder & "\" & oFileName & ".xlsx"

Dim oSheet As Sheet = oDOc.Sheets.Item(1)
Dim oPartList As PartsList = oSheet.PartsLists.Item(1)
Dim oOptions As NameValueMap = ThisApplication.TransientObjects.CreateNameValueMap

'get the Inventor user name from the Inventor Options
myName= ThisApplication.GeneralOptions.UserName

'define Excel Application object
excelApp = CreateObject("Excel.Application")
'set Excel to run visibly, change to false if you want to run it invisibly
excelApp.Visible = False
'suppress prompts (such as the compatibility checker)
excelApp.DisplayAlerts = False


'check for existing file 
If Dir(myXLS_File) <> "" Then
'workbook exists, open it
excelWorkbook = excelApp.Workbooks.Open(myXLS_File)
'set the first sheet active
excelSheet = excelWorkbook.Worksheets(1).activate
Else
'workbook does NOT exist, so create a new one using the default template
'excelWorkbook = excelApp.Workbooks.Add
' or use this syntax to specify a template to use
excelWorkbook =  excelApp.Workbooks.Add	("\\Fig015\cad\0-0-Veritas\Drawing Checklist\Drawing Checklist.xlsm")
End If

'Insert data into Excel.
With excelApp
    .Range("A4").Select
    .ActiveCell.FormulaR1C1 = iProperties.Value("Custom", "Order Number")
	.Range("C4").Select
    .ActiveCell.FormulaR1C1 = iProperties.Value("Custom", "Client Name")
	.Range("F4").Select
    .ActiveCell.FormulaR1C1 = iProperties.Value("Custom", "Project Name")
	.Range("K4").Select
    .ActiveCell.FormulaR1C1 = ThisApplication.GeneralOptions.UserName
	.Range("I4").Select
    .ActiveCell.FormulaR1C1 = iProperties.Value("Custom", "Project Team")
End With   

'set all of the columns to autofit
'excelApp.Columns.AutoFit   
'save the file
excelWorkbook.SaveAs(myXLS_File)

''close the workbook and the Excel Application
''uncomment if you want to close the xls file at the end
excelWorkbook.Close
excelApp.Quit
excelApp = Nothing

 If the code comes to work, then try to eliminate these lines, I think they are unnecessary.

Dim oOptions As NameValueMap = ThisApplication.TransientObjects.CreateNameValueMap

'get the Inventor user name from the Inventor Options
myName= ThisApplication.GeneralOptions.UserName

I hope this helps with your problem. regards

[Anonymous]

This works perfectly! thank you!