1 Reply Latest reply on Apr 22, 2014 8:38 AM by Francisco Amores

    export all maps (mappings for all dimensions in Excel) - II


      In Dec 14, 2011 beyerch posted the below solution for topic "export all maps (mappings for all dimensions in Excel) "


      i copied the the script as is, when running i receive the following error

      Error: An Error occurred runnning the script:

      1004 - Cannot rename a sheet to the same name as another sheet, a refernced object library or a workboor references by Visual Basic

      At Line 141


      Line 141  =  oSheet.name = strCurrDimName


      Can someone help solve this scripting error


      Sub ExportAllCurrDimMapsForLocationtoXLS()
      'UpStream WebLink DM Custom Script:
      'Created By:         cbeyer
      'Date Created:       11-23-11
      'Purpose:               Export all dimension maps to an Excel workbook      

      'Declare Constant
      'NOTE : This will control whether the function gets the current map in the system or whether it looks back for a specific Period
      '       FDM stores the Map for each period that was loaded... You may want to export a particular POV Period for audit purposes, etc.
      '       IF you enable this, be sure to set the POV Period before running.....
      Const boolgetPOVPeriodMap = False

      'Declare working variables
      Dim intPartitionKey
      Dim strOutputMessage
      Dim strSQL
      Dim strCategoryFreq
      Dim objPeriodKey
      Dim strOutputFileName
      Dim strOutputFilePath

      'Get the location (PartitionKey
      intPartitionKey = RES.PlngLocKey

      'Create SQL Query to get Current Map Data
      If boolgetPOVPeriodMap = False Then
           strSQL = "SELECT * FROM tDataMap where PartitionKey = " & intPartitionKey & " order by DimName ASC"
           strCategoryFreq = API.POVMgr.fCategoryFreq(API.POVMgr.PPOVCategory)
           Set objPeriodKey = API.POVMgr.fPeriodKey(API.POVMgr.PPOVPeriod, 0, strCategoryFreq)
           strSQL = "SELECT * from vDataMap where PartitionKey = " & intPartitionKey & " and PeriodKey = '" & objPeriodKey.dteDateKey & " 12:00:00 AM' order by DimName Asc"
      End If

      'Create Recordset for all Exported Entities
      Set rsMap = DW.DataAccess.farsKeySet(strSQL)

      If rsMap.EOF And rsMap.BOF Then
           'No records
           If boolgetPOVPeriodMap = False Then
                strOutputMessage = "No Mapping data was found For " & API.POVMgr.PPOVLocation & ".  If this location Is using Parent Maps, you can only export mapping data at the parent location."    
                strOutputMessage = "No Mapping data was found For " & API.POVMgr.PPOVLocation & " for period " & API.POVMgr.PPOVPeriod & ".  If this location Is using Parent Maps, you can only export mapping data at the parent location."         
           End If
           'Records Exist, process
           'Generate file name / path
           If boolgetPOVPeriodMap = False Then
                strOutputFileName = API.POVMgr.PPOVLocation & "_DimensionMaps.xls"
                strOutputFileName = API.POVMgr.PPOVLocation & "_" & objPeriodKey.strDateKey & "_DimensionMaps.xls"
           End If
           strOutputFilePath = DW.Connection.PstrDirOutbox & "\ExcelFiles\"

           'Create Excel file reference    
           'Declare Excel working variables
           Dim oExcel
           Dim oBook
           Dim oSheet 'No puns here......
           Dim oRange
           Dim intCurrentSheetOrdinal
           Dim intCurrentRowOrdinal
           Dim intCurrentColOrdinal

           'Intialize Excel
           Set oExcel = CreateObject("Excel.Application")
           Set oBook = oExcel.Workbooks.Add

           'Declare working variables
           Dim strCurrDimName
           'Initialize variables
           strCurrDimName = ""
           intCurrentSheetOrdinal = 1
           intCurrentRowOrdinal = 1
           intCurrentColOrdinal = 1
           With rsMap
                Do Until .eof
                     'Check to see if current DimName matches existing DimName.  If not, add headers
                     If rsMap.fields("DimName") <> strCurrDimName Then
                           'If the dimension name has changed to a different dimension name, show total information before starting headers
                           'If the previous dimension was not "", then we are transitioning from one range to the next.  Lets create a named range on the just
                           'finished worksheet because we can or because you may want to use this for re-uploading
                           'NOTE : The range I'm creating is more for reference as to how to implement this and I don't know if I'm making the range in a fashion that
                           'FDM will pickup for importing. 
                           'NOTE : You probably want intCurrentRowOrdinal - 1 since it is 1 row past the last row of data at this point.  If you want to clean it up,
                           'then you need to make sure RowOrdinal is not going to be less than the starting point and I didn't feel like adding the couple rows of
                           'code to do the work properly as FDM will just ignore the blank row in all likelihood.
                                                                        If strCurrDimName <> "" Then
                                  Set oRange = oSheet.Range("A6:K" & intCurrentRowOrdinal)
                                  oBook.Names.Add "ups"&strCurrDimName, oRange
                           End If

                           'Create worksheet reference
                             Set oSheet = oBook.Worksheets(intCurrentSheetOrdinal)                    
                            'Create default header at top of each new dimension group
                               If boolgetPOVPeriodMap = False Then
                                    oSheet.range("A1") = (API.POVMgr.PPOVLocation & " - Map Conversion")
                                    oSheet.range("A1") = (API.POVMgr.PPOVLocation & " - Map Conversion for " & rsMap.fields("PeriodKey"))
                               End If

                               oSheet.range("A3") = "Partition: " & API.POVMgr.PPOVLocation
                               oSheet.range("A4") = "User ID: " & DW.Connection.PstrUserID
                               'NOTE: I could make an array of the field names and do a loop here; however, this is easier to read.....
                               '      probably not how I would do it from an efficiency standpoint, but since it's a limited number of fields
                               '      this will work.....
                                   oSheet.range("A5") = "PartitionKey"
                                   oSheet.range("B5") = "DimName"
                                   oSheet.range("C5") = "Source FM Account"
                                   oSheet.range("D5") = "Description"
                                   oSheet.range("E5") = "Target FM Account"
                                   oSheet.range("F5") = "WhereClauseType"
                                   oSheet.range("G5") = "WhereClauseValue"
                                   oSheet.range("H5") = "-"
                                   oSheet.range("I5") = "Sequence"
                                   oSheet.range("J5") = "DataKey"
                                   oSheet.range("K5") = "VBScript"
                               'Update variables                  
                                  strCurrDimName = rsMap.fields("DimName")
                                  intCurrentRowOrdinal = 6
                                  intCurrentSheetOrdinal = intCurrentSheetOrdinal + 1
                                  'Update worksheet name
                                  oSheet.name = strCurrDimName

                     End If

                       'Write Details
                              oSheet.range("A" & intCurrentRowOrdinal) = intPartitionKey
                       oSheet.range("B" & intCurrentRowOrdinal) = rsMap.fields("DimName").Value
                       oSheet.range("C" & intCurrentRowOrdinal) = rsMap.fields("SrcKey").Value
                       oSheet.range("D" & intCurrentRowOrdinal) = rsMap.fields("SrcDesc").Value
                       oSheet.range("E" & intCurrentRowOrdinal) = rsMap.fields("TargKey").Value
                       oSheet.range("F" & intCurrentRowOrdinal) = rsMap.fields("WhereClauseType").Value
                       oSheet.range("G" & intCurrentRowOrdinal) = rsMap.fields("WhereClauseValue").Value
                       oSheet.range("H" & intCurrentRowOrdinal) = rsMap.fields("ChangeSign").Value
                       oSheet.range("I" & intCurrentRowOrdinal) = rsMap.fields("Sequence").Value
                       oSheet.range("J" & intCurrentRowOrdinal) = rsMap.fields("DataKey").Value
                       oSheet.range("K" & intCurrentRowOrdinal) = rsMap.fields("VBScript").Value

                     'Increment Counters
                     intCurrentRowOrdinal = intCurrentRowOrdinal + 1
                     'Move to the next record
           End With

           'Final Sheet Named Range addition
           'Since the loop will end and we will not execute the above logic to create the range for the previous sheet
           'the easiest (laziest) solution is to just handle the last sheet after the loop.
           'We're basically doing the same stuff we did above, just down here.
            If strCurrDimName <> "" Then
                Set oRange = oSheet.Range("A6:K" & intCurrentRowOrdinal)
                 oBook.Names.Add "ups"&strCurrDimName, oRange
            End If     

           'Close / release file objects
           'Added some logic here to ensure you don't get caught up on the file replace prompt.
           oExcel.Application.DisplayAlerts = False
           oBook.SaveAs strOutputFilePath & strOutputFileName
           oExcel.Application.DisplayAlerts = True

           'Create output message         
           strOutputMessage = "Mapping data export for " & API.POVMgr.PPOVLocation  & " complete.  Extract file is : " & strOutputFilePath & strOutputFileName
      End If

      'Close / release data objects

      'Display output
      If LCase(API.DataWindow.Connection.PstrClientType) = "workbench" Then
                MsgBox strOutputMessage       
           'Let the user know we are done
           RES.PlngActionType = 2
           RES.PstrActionValue = strOutputMessage
      End If

      End Sub