Solved

Excel VBA Macro export worksheet to ;-separated CSV to user desktop

Posted on 2014-09-17
8
1,684 Views
Last Modified: 2014-09-17
Dear expert,

i'm looking for a macro, export a worksheet called "export" into a semicolon separated CSV file
to User desktop  

Pls see example and attachment

i've found this example. I think still needs to be adjusted a little ???
1. where the file is to be saved  (user desktop)
2.Only the worksheet export should be saved


Option Explicit
Sub export2csv()
    Dim lastColumn As Integer
    Dim lastRow As Integer
    Dim strString As String
    Dim i As Integer, j As Integer

    lastColumn = ActiveSheet.UsedRange.Column - 1 + ActiveSheet.UsedRange.Columns.Count
    lastRow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row

    Open "export.csv" For Output As #1

    For i = 1 To lastRow
        Cells(i, 1).Select
        strString = ""
        For j = 1 To lastColumn
            If j <> lastColumn Then
                strString = strString & Cells(i, j).Value & ";" ' Use semicolon instead of pipe.
            Else
                strString = strString & Cells(i, j).Value
            End If
        Next j
        Print #1, strString
    Next i

    Close #1
End Sub

Open in new window



UserId;Name;Comp;LOC;ET;IdentNo;ANo;IF;Date;Action;Product;Version;SMTP;SMTP2
S12345;JONES, MIKE;GUL;TEST;I;2431102;O157658;S;2013-05-17 11:52:33;Delete;PMAl;MS;mike.jones@gul.com
S12345;JONES, MIKE;GUL;TEST;I;2431175;O157658;S;2013-05-17 12:50:11;New;PMAL;mike.jones@gul.com
S12345;JONES, MIKE;GUL;TEST;I;2431192;O157658;S;2013-05-17 13:08:33;Delete;PMAL;MS;mike.jones@gul.com
S12345;JONES, MIKE;GUL;TEST;I;2431193;O157658;S;2013-05-17 13:08:33;Delete;PMAL;MS;;mike.jones@gul.com

Thank you so much for your help!!!
Mandy
Export.csv
0
Comment
Question by:Mandy_
  • 4
  • 3
8 Comments
 
LVL 35

Expert Comment

by:[ fanpages ]
ID: 40328202
Hi Mandy,

I have attached a workbook containing the following code:

Option Explicit

Private Declare Sub CoTaskMemFree _
                Lib "ole32.dll" _
             (ByVal pvoid As Long)

Private Declare Function SHGetPathFromIDList _
                     Lib "shell32.dll" _
                   Alias "SHGetPathFromIDListA" _
                   (ByVal Pidl As Long, _
                    ByVal pszPath As String) As Long

Private Declare Function SHGetSpecialFolderLocation _
                     Lib "shell32.dll" _
                  (ByVal hWnd As Long, _
                   ByVal nFolder As Long, _
                   ByRef ppidl As Long) As Long
Private Function strSpecial_Folder(ByVal lngFolder As Long) As String
  
' --------------------------------------------------------------------------------------------------------------
' [ http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_28140660.html ]
' --------------------------------------------------------------------------------------------------------------
  
  Dim lngPidl                                           As Long
  Dim lngPidlFound                                      As Long
  Dim strPath                                           As String
  Dim strReturn                                         As String
  
  On Error GoTo Err_strSpecial_Folder
  
  Const MAX_PATH                                        As Long = 260&
  
  strReturn = ""
  strPath = Space(MAX_PATH)
  
  lngPidlFound = SHGetSpecialFolderLocation(0&, lngFolder, lngPidl)

  If lngPidlFound = 0& Then
     If (SHGetPathFromIDList(lngPidl, strPath)) Then
        strReturn = Left$(strPath, InStr(1&, strPath, vbNullChar) - 1&)
    End If ' If (SHGetPathFromIDList(lngPidl, strPath)) Then
  End If ' If lngPidlFound = 0& Then
  
Exit_strSpecial_Folder:

  On Error Resume Next
  
  If lngPidl <> 0& Then
     Call CoTaskMemFree(lngPidl)
  End If ' If lngPidl <> 0& Then
  
  strSpecial_Folder = strReturn
  
  Exit Function
  
Err_strSpecial_Folder:

  On Error Resume Next
  
  strReturn = ""
  
  Resume Exit_strSpecial_Folder
  
End Function
Public Sub Q_28520034()

  Dim hndFile                                           As Long
  Dim intColumn                                         As Integer
  Dim intLast_Column                                    As Integer
  Dim lngLast_Row                                       As Long
  Dim lngRow                                            As Long
  Dim strDesktop_Folder                                 As String
  Dim strOutput                                         As String
  
  strDesktop_Folder = strSpecial_Folder(&H10)

  intLast_Column = Worksheets("Export").UsedRange.Column - 1 + Worksheets("Export").UsedRange.Columns.Count
  lngLast_Row = Worksheets("Export").UsedRange.Rows(Worksheets("Export").UsedRange.Rows.Count).Row

  hndFile = FreeFile
  
  Open strDesktop_Folder & "\export.csv" For Output As #hndFile

  For lngRow = 1& To lngLast_Row
  
      strOutput = ""
    
      For intColumn = 1 To intLast_Column
          strOutput = strOutput & Worksheets("Export").Cells(lngRow, intColumn).Value & ";"
      Next intColumn
      
      Print #1, Left$(strOutput, Len(strOutput) - 1)
      
  Next lngRow

  Close #hndFile
    
End Sub

Open in new window



A row from your example data is also missing an entry for the "Version" column:
S12345;JONES, MIKE;GUL;TEST;I;2431175;O157658;S;2013-05-17 12:50:11;New;PMAL;mike.jones@gul.com

That is...
S12345;JONES, MIKE;GUL;TEST;I;2431175;O157658;S;2013-05-17 12:50:11;New;<MISSING>;PMAL;mike.jones@gul.com

Also, I believe the contents of the "export.csv" file should actually be as follows:
---
UserId;Name;Comp;LOC;ET;IdentNo;ANo;IF;Date;Action;Product;Version;SMTP;SMTP2
S12345;JONES, MIKE;GUL;TEST;I;2431102;O157658;S;17/05/2013 11:52:33;Delete;PMAl;MS;mike.jones@gul.com;
S12345;JONES, MIKE;GUL;TEST;I;2431175;O157658;S;17/05/2013 12:50:11;New;PMAL;;mike.jones@gul.com;
S12345;JONES, MIKE;GUL;TEST;I;2431192;O157658;S;17/05/2013 13:08:33;Delete;PMAL;MS;mike.jones@gul.com;
S12345;JONES, MIKE;GUL;TEST;I;2431193;O157658;S;17/05/2013 13:08:33;Delete;PMAL;MS;;mike.jones@gul.com
---

That is the first three rows of data do end with a semi-colon because of the absence of the "SMTP2" column data for those rows.
Q-28520034.xls
export.csv
0
 
LVL 39

Accepted Solution

by:
als315 earned 350 total points
ID: 40328236
Will be better if you upload source file
You can find desktop folder with this code:
Dim UD as String
UD =  CreateObject("WScript.Shell").specialfolders("Desktop")
UD = UD & "\export.csv"
Open UD For Output As #1

Open in new window

In your sample Activeworksheet is exported, change it to EXPORT
whole code:
Sub export2csv()
    Dim lastColumn As Integer
    Dim lastRow As Integer
    Dim strString As String
    Dim i As Integer, j As Integer
    Dim UD As String
    
    UD = CreateObject("WScript.Shell").specialfolders("Desktop")
    UD = UD & "\export.csv"
    Worksheets("EXPORT").Activate
    lastColumn = ActiveSheet.UsedRange.Column - 1 + ActiveSheet.UsedRange.Columns.Count
    lastRow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row

    Open UD For Output As #1

    For i = 1 To lastRow
        Cells(i, 1).Select
        strString = ""
        For j = 1 To lastColumn
            If j <> lastColumn Then
                strString = strString & Cells(i, j).Value & ";" ' Use semicolon instead of pipe.
            Else
                strString = strString & Cells(i, j).Value
            End If
        Next j
        Print #1, strString
    Next i

    Close #1
End Sub

Open in new window

0
 
LVL 35

Expert Comment

by:[ fanpages ]
ID: 40328240
Sorry... I was mid-editing my comment when the other expert (als315) posted so the edit process failed.

Please find attached an updated workbook will a small amendment.
Q-28520034.xls
0
 
LVL 2

Author Comment

by:Mandy_
ID: 40328264
dear fanpages,

thanks for your help. I'm sorry but its still not running. this code below has to be switch to 64bit code. Declare should be mark with ptr_save attribut.

Private Declare Sub CoTaskMemFree _
                Lib "ole32.dll" _
             (ByVal pvoid As Long)

Private Declare Function SHGetPathFromIDList _
                     Lib "shell32.dll" _
                   Alias "SHGetPathFromIDListA" _
                   (ByVal Pidl As Long, _
                    ByVal pszPath As String) As Long

Private Declare Function SHGetSpecialFolderLocation _
                     Lib "shell32.dll" _
                  (ByVal hWnd As Long, _
                   ByVal nFolder As Long, _
                   ByRef ppidl As Long) As Long

Open in new window

0
Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

 
LVL 35

Expert Comment

by:[ fanpages ]
ID: 40328289
Hi Mandy,

Sorry (again), I was not aware you required 64-bit compliant code.

Please disregard my input.  I will not be able to progress with the necessary changes.

I suggest you continue with als315's contribution in preference to my own.
0
 
LVL 2

Author Comment

by:Mandy_
ID: 40328357
dear als315,

your code working fine so far. Would it still possible to remove the spaces? For example sometimes i have data in row 2 to 30 and 151 to 180 and 186 to 220. The empty rows, the spaces between, should be removed. Thanks in advance.
0
 
LVL 35

Assisted Solution

by:[ fanpages ]
[ fanpages ] earned 150 total points
ID: 40328407
Hi Mandy,

To address your issue with empty rows, I would change this line:

Print #1, strString

To read like this:

If Len(Trim$(Replace(strString, ";", ""))) > 0 Then
   Print #1, strString
End If


I have attached a new version of my workbook, using als315's method of obtaining the User's Desktop folder.

This version should run within your 64-bit based environment.
Q-28520034.xls
export.csv
0
 
LVL 2

Author Closing Comment

by:Mandy_
ID: 40328472
Many thanks and respect . Great work!
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

This is pretty cool.  The purpose of this VB Script is to help you document where JAR (Java ARchive) files and specifically java class files are located so that you can address issues seen with a client or that you can speak intelligently with a dev…
This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

705 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now