CleverSnake

Power Pivot to csv

Oct 24th, 2020
414
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. ' made by mptevsion
  2. ' modified by Aj, 24.10.2020
  3.  
  4. Public Sub CreatePowerPivotDmvInventory()
  5.     ActiveWorkbook.Model.Initialize
  6.    
  7.     Dim save_path As String
  8.     Dim chunk_size As Long
  9. '    Dim sorting_column As String
  10.    
  11.     save_path = "C:\csv"
  12.     dmvName = "Лист1"
  13.     chunk_size = 100000
  14. '    sorting_column = "[Месяц]"
  15.  
  16.     Dim rs As ADODB.Recordset
  17.     Dim mdx As String
  18.     Dim i As Long
  19.  
  20.     Dim rows_limit As Long
  21.     Dim rows_left As Long
  22.    
  23.     Dim conn As ADODB.Connection
  24.     Set conn = ActiveWorkbook.Model.DataModelConnection.ModelConnection.ADOConnection
  25.    
  26.     ' calculating number of rows in a table
  27.    mdx = "evaluate {COUNTROWS('" & dmvName & "')}"
  28.     Set rs = New ADODB.Recordset
  29.     rs.ActiveConnection = conn
  30.     rs.Open mdx, conn, adOpenForwardOnly, adLockOptimistic
  31.     rows_limit = rs.Fields(0)
  32.    
  33.     rows_left = rows_limit
  34.     chunk_id = 1
  35.    
  36.     Do While rows_left > 0
  37.         If rows_left < chunk_size Then
  38.             chunk_size = rows_left
  39.         End If
  40.    
  41.         mdx = "define var data_table = '" & dmvName & "'" & Chr(10) & _
  42.             "EVALUATE(" & Chr(10) & _
  43.             "    TOPNSKIP(" & chunk_size & ", " & rows_limit - rows_left & ", data_table)" & Chr(10) & _
  44.             ");"
  45.         Debug.Print (mdx)
  46.  
  47.         Set rs = New ADODB.Recordset
  48.         rs.ActiveConnection = conn
  49.         rs.Open mdx, conn, adOpenForwardOnly, adLockOptimistic
  50.  
  51.         ' Setup CSV file (improve this code)
  52.        Dim myFile As String
  53.         myFile = save_path & "\vba_tbl_" & dmvName & "_" & chunk_id & ".csv"
  54.         Debug.Print (myFile)
  55.         Open myFile For Output As #1
  56.  
  57.         ' Output column names
  58.        For i = 0 To rs.Fields.Count - 1
  59.             If i = rs.Fields.Count - 1 Then
  60.                 Write #1, """" & rs.Fields(i).Name & """"
  61.             Else
  62.                 Write #1, """" & rs.Fields(i).Name & """",
  63.             End If
  64.         Next i
  65.  
  66.         ' Output of the query results
  67.        Do Until rs.EOF
  68.             For i = 0 To rs.Fields.Count - 1
  69.                 If i = rs.Fields.Count - 1 Then
  70.                     Write #1, """" & rs.Fields(i) & """"
  71.                 Else
  72.                     Write #1, """" & rs.Fields(i) & """",
  73.                 End If
  74.             Next i
  75.             rs.MoveNext
  76.         Loop
  77.  
  78.         rows_left = rows_left - chunk_size
  79.         chunk_id = chunk_id + 1
  80.  
  81.         Close #1
  82.         rs.Close
  83.         Set rs = Nothing
  84.     Loop
  85.        
  86.     MsgBox "Finished"
  87.     Exit Sub
  88.  
  89. FailureOutput:
  90.     MsgBox Err.Description
  91. End Sub
  92.  
  93.  
  94.  
RAW Paste Data