CleverSnake

Power Pivot to csv

Oct 24th, 2020
892
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

Adblocker detected! Please consider disabling it...

We've detected AdBlock Plus or some other adblocking software preventing Pastebin.com from fully loading.

We don't have any obnoxious sound, or popup ads, we actively block these annoying types of ads!

Please add Pastebin.com to your ad blocker whitelist or disable your adblocking software.

×