Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
First upload
A VBA class for Excel to create a CSV or OFX file
  • Loading branch information
cclambie committed Dec 30, 2017
1 parent c4756d1 commit 0783355
Show file tree
Hide file tree
Showing 2 changed files with 334 additions and 0 deletions.
299 changes: 299 additions & 0 deletions VBA_Module.mod
@@ -0,0 +1,299 @@
Option Explicit
Sub ExportAsCSV()

Dim MyFileName As String
Dim CurrentWB As Workbook, TempWB As Workbook

Set CurrentWB = ActiveWorkbook
ActiveWorkbook.ActiveSheet.UsedRange.Copy

Set TempWB = Application.Workbooks.Add(1)
With TempWB.Sheets(1).Range("A1")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With

'Dim Change below to "- 4" to become compatible with .xls files
MyFileName = CurrentWB.Path & "\" & Left(CurrentWB.Name, Len(CurrentWB.Name) - 5) & ".csv"
Application.DisplayAlerts = False
TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
TempWB.Close SaveChanges:=False
Application.DisplayAlerts = True
End Sub
Public Sub cbGenerateOFX()
' Generate OFX file from the data in the 'Export to OFX' spreadsheet

On Error Resume Next

' General variables
Dim iResult As Integer
Dim iTransaction As Integer
Dim dtDatetime As Date
' Output file name
Dim OutputFilename As String

Dim CurrentWB As Workbook, TempWB As Workbook

Set CurrentWB = ActiveWorkbook

' OFX file header
Dim OFX_HEADER As String
Dim OFX_SIGNONMSGSRSV1_HEADER As String
Dim OFX_SIGNONMSGSRSV1_DTSERVER As String
Dim OFX_SIGNONMSGSRSV1_FOOTER As String
Dim OFX_BANKMSGSRSV1_HEADER As String
Dim OFX_BANKMSGSRSV1_FOOTER As String
' Bank account information
Dim OFX_BANKACCTFROM_HEADER As String
Dim OFX_BANKID As String
Dim OFX_ACCTID As String
Dim OFX_ACCTTYPE As String
Dim OFX_BANKACCTFROM_FOOTER As String

' Transaction list information
Dim OFX_BANKTRANLIST_HEADER As String
Dim OFX_BANKTRANLIST_DTSTART As String
Dim OFX_BANKTRANLIST_DTEND As String
Dim OFX_BANKTRANLIST_FOOTER As String
' Transactions information
Dim OFX_STMTTRN_HEADER As String
Dim OFX_STMTTRN_TRNTYPE As String
Dim OFX_STMTTRN_DTPOSTED As String
Dim OFX_STMTTRN_TRNAMT As String
Dim OFX_STMTTRN_FITID As String
Dim OFX_STMTTRN_NAME As String
Dim OFX_STMTTRN_MEMO As String
Dim OFX_STMTTRN_FOOTER As String

' Ledger balance information
Dim OFX_LEDGERBAL_HEADER As String
Dim OFX_LEDGERBAL_BALAMT As String
Dim OFX_LEDGERBAL_DTASOF As String
Dim OFX_LEDGERBAL_FOOTER As String
' Closing tag
Dim OFX_FOOTER As String
Dim OFX_STMTRS_FOOTER As String
Dim OFX_STMTTRNRS_FOOTER As String


' OFX file header
OFX_HEADER = "OFXHEADER:100" & Chr(13) & _
"DATA:OFXSGML" & Chr(13) & _
"VERSION:102" & Chr(13) & _
"SECURITY:NONE" & Chr(13) & _
"ENCODING:USASCII" & Chr(13) & _
"CHARSET:1252" & Chr(13) & _
"COMPRESSION:NONE" & Chr(13) & _
"OLDFILEUID:NONE" & Chr(13) & _
"NEWFILEUID:NONE" & Chr(13) & _
"<OFX>" & Chr(13)
OFX_SIGNONMSGSRSV1_HEADER = Chr(9) & "<SIGNONMSGSRSV1>" & Chr(13) & _
Chr(9) & Chr(9) & "<SONRS>" & Chr(13) & _
Chr(9) & Chr(9) & Chr(9) & "<STATUS>" & Chr(13) & _
Chr(9) & Chr(9) & Chr(9) & Chr(9) & "<CODE>0" & Chr(13) & _
Chr(9) & Chr(9) & Chr(9) & Chr(9) & "<SEVERITY>INFO" & Chr(13) & _
Chr(9) & Chr(9) & Chr(9) & "</STATUS>"
OFX_SIGNONMSGSRSV1_DTSERVER = Chr(9) & Chr(9) & Chr(9) & "<DTSERVER>"
OFX_SIGNONMSGSRSV1_FOOTER = Chr(9) & Chr(9) & Chr(9) & "<LANGUAGE>ENG" & Chr(13) & _
Chr(9) & Chr(9) & "</SONRS>" & Chr(13) & _
Chr(9) & "</SIGNONMSGSRSV1>"
OFX_BANKMSGSRSV1_HEADER = Chr(9) & "<BANKMSGSRSV1>" & Chr(13) & _
Chr(9) & Chr(9) & "<STMTTRNRS>" & Chr(13) & _
Chr(9) & Chr(9) & Chr(9) & "<TRNUID>0" & Chr(13) & _
Chr(9) & Chr(9) & Chr(9) & "<STATUS>" & Chr(13) & _
Chr(9) & Chr(9) & Chr(9) & Chr(9) & "<CODE>0" & Chr(13) & _
Chr(9) & Chr(9) & Chr(9) & Chr(9) & "<SEVERITY>INFO" & Chr(13) & _
Chr(9) & Chr(9) & Chr(9) & "</STATUS>" & Chr(13) & _
Chr(9) & Chr(9) & "<STMTRS>" & Chr(13) & _
Chr(9) & Chr(9) & Chr(9) & "<CURDEF>"
OFX_STMTRS_FOOTER = Chr(9) & Chr(9) & Chr(9) & "</STMTRS>"
OFX_STMTTRNRS_FOOTER = Chr(9) & Chr(9) & Chr(9) & "</STMTTRNRS>"
OFX_BANKMSGSRSV1_FOOTER = Chr(9) & "</BANKMSGSRSV1>"
' Bank account information
OFX_BANKACCTFROM_HEADER = Chr(9) & Chr(9) & Chr(9) & "<BANKACCTFROM>"
OFX_BANKID = Chr(9) & Chr(9) & Chr(9) & Chr(9) & "<BANKID>"
OFX_ACCTID = Chr(9) & Chr(9) & Chr(9) & Chr(9) & "<ACCTID>"
OFX_ACCTTYPE = Chr(9) & Chr(9) & Chr(9) & Chr(9) & "<ACCTTYPE>"
OFX_BANKACCTFROM_FOOTER = Chr(9) & Chr(9) & Chr(9) & "</BANKACCTFROM>"

' Transaction list information
OFX_BANKTRANLIST_HEADER = Chr(9) & Chr(9) & Chr(9) & "<BANKTRANLIST>"
OFX_BANKTRANLIST_DTSTART = Chr(9) & Chr(9) & Chr(9) & Chr(9) & "<DTSTART>"
OFX_BANKTRANLIST_DTEND = Chr(9) & Chr(9) & Chr(9) & Chr(9) & "<DTEND>"
OFX_BANKTRANLIST_FOOTER = Chr(9) & Chr(9) & Chr(9) & Chr(9) & "</BANKTRANLIST>"
' Transactions information
OFX_STMTTRN_HEADER = Chr(9) & Chr(9) & Chr(9) & Chr(9) & "<STMTTRN>"
OFX_STMTTRN_TRNTYPE = Chr(9) & Chr(9) & Chr(9) & Chr(9) & Chr(9) & "<TRNTYPE>"
OFX_STMTTRN_DTPOSTED = Chr(9) & Chr(9) & Chr(9) & Chr(9) & Chr(9) & "<DTPOSTED>"
OFX_STMTTRN_TRNAMT = Chr(9) & Chr(9) & Chr(9) & Chr(9) & Chr(9) & "<TRNAMT>"
OFX_STMTTRN_FITID = Chr(9) & Chr(9) & Chr(9) & Chr(9) & Chr(9) & "<FITID>"
OFX_STMTTRN_NAME = Chr(9) & Chr(9) & Chr(9) & Chr(9) & Chr(9) & "<NAME>"
OFX_STMTTRN_MEMO = Chr(9) & Chr(9) & Chr(9) & Chr(9) & Chr(9) & "<MEMO>"
OFX_STMTTRN_FOOTER = Chr(9) & Chr(9) & Chr(9) & Chr(9) & "</STMTTRN>"

' Ledger balance information
OFX_LEDGERBAL_HEADER = Chr(9) & Chr(9) & Chr(9) & Chr(9) & "<LEDGERBAL>"
OFX_LEDGERBAL_BALAMT = Chr(9) & Chr(9) & Chr(9) & Chr(9) & Chr(9) & "<BALAMT>"
OFX_LEDGERBAL_DTASOF = Chr(9) & Chr(9) & Chr(9) & Chr(9) & Chr(9) & "<DTASOF>"
OFX_LEDGERBAL_FOOTER = Chr(9) & Chr(9) & Chr(9) & Chr(9) & "</LEDGERBAL>"
' Closing tag
OFX_FOOTER = "</OFX>"

' Open output file
'OutputFilename = Worksheets("XLS2OFX").Range("OutputFile")
OutputFilename = CurrentWB.Path & "\" & Left(CurrentWB.Name, Len(CurrentWB.Name) - 5) & ".ofx"

Dim fs
Dim ofxstream

Set fs = CreateObject("Scripting.FileSystemObject")
Set ofxstream = fs.CreateTextFile(OutputFilename, True)

Dim iReturn As Integer
Dim StatementStartDate As String
Dim StatementEndDate As String


If Err.Number <> 0 Then
iReturn = MsgBox(Error(Err.Number), vbCritical, "XLS2OFX Runtime Error")
Else
' Write OFX Header
ofxstream.WriteLine (OFX_HEADER)
ofxstream.WriteLine (OFX_SIGNONMSGSRSV1_HEADER)
'Date format is 20031010000000.000[-5:EST]
'dtDatetime = Worksheets("XLS2OFX").Range("StatementStartDate")
dtDatetime = ActiveSheet.Range("A2")
StatementStartDate = Format(dtDatetime, "yyyymmdd") & "000000.000[-5:EST]"
ofxstream.WriteLine (OFX_SIGNONMSGSRSV1_DTSERVER & StatementStartDate)
ofxstream.WriteLine (OFX_SIGNONMSGSRSV1_FOOTER)
Dim AcctCurrency As String
AcctCurrency = "AUD" '= Worksheets("XLS2OFX").Range("AcctCurrency")
ofxstream.WriteLine (OFX_BANKMSGSRSV1_HEADER & AcctCurrency)

ofxstream.WriteLine (OFX_BANKACCTFROM_HEADER)
Dim BankId As String
BankId = "BANK" 'Worksheets("XLS2OFX").Range("BankId")
ofxstream.WriteLine (OFX_BANKID & BankId)
Dim AccountNo As String
AccountNo = "ACCOUNT" 'Worksheets("XLS2OFX").Range("AccountNo")
ofxstream.WriteLine (OFX_ACCTID & AccountNo)
Dim AcctType As String
AcctType = "STATEMENT" 'Worksheets("XLS2OFX").Range("AcctType")
ofxstream.WriteLine (OFX_ACCTTYPE & AcctType)
ofxstream.WriteLine (OFX_BANKACCTFROM_FOOTER)
' Write financial transactions
ofxstream.WriteLine (OFX_BANKTRANLIST_HEADER)
ofxstream.WriteLine (OFX_BANKTRANLIST_DTSTART & StatementStartDate)
'StatementStartDate = Worksheets("XLS2OFX").Range("StatementEndDate")
dtDatetime = Cells(Rows.Count, 1).End(xlUp).Value 'Worksheets("XLS2OFX").Range("StatementEndDate ")
StatementEndDate = Format(dtDatetime, "yyyymmdd") & "000000.000[-5:EST]"
ofxstream.WriteLine (OFX_BANKTRANLIST_DTEND & StatementEndDate)

Dim PreviousBalance
PreviousBalance = 0 'Worksheets("XLS2OFX").Range("PreviousBalance")
Dim FinalBalance
FinalBalance = PreviousBalance
iTransaction = 1
Dim rgeTransactionList As Range
Set rgeTransactionList = CurrentWB.ActiveSheet.Range("A1")
'Is Credit Card?
Dim tfCreditCard As Boolean

tfCreditCard = MsgBox("Is this statement a Credit Card?", vbYesNo)


While rgeTransactionList.Offset(iTransaction, 0).Value <> ""
'Get transaction information
dtDatetime = rgeTransactionList.Offset(iTransaction, 0).Value ' Worksheets("XLS2OFX").Range("TransactionListTop").Offset(iTransaction, 0).Value
Dim sTranDate
sTranDate = Format(dtDatetime, "yyyymmdd") & "000000.000[-5:EST]"
Dim sTranName As String
sTranName = rgeTransactionList.Offset(iTransaction, 1).Value
Dim sTranMemo
sTranMemo = "" 'rgeTransactionList.Offset(iTransaction, 2).Value
Dim sTranAmount As Double
sTranAmount = rgeTransactionList.Offset(iTransaction, 2).Value
'Record transaction in OFX format
ofxstream.WriteLine (OFX_STMTTRN_HEADER)

If tfCreditCard Then
If sTranAmount > 0 Then
ofxstream.WriteLine (OFX_STMTTRN_TRNTYPE & "CREDIT")
sTranAmount = sTranAmount * -1
FinalBalance = FinalBalance + Val(sTranAmount)
Else
ofxstream.WriteLine (OFX_STMTTRN_TRNTYPE & "DEBIT")
sTranAmount = sTranAmount * -1
FinalBalance = FinalBalance - Val(sTranAmount)
End If
Else
If sTranAmount < 0 Then
ofxstream.WriteLine (OFX_STMTTRN_TRNTYPE & "CREDIT")
sTranAmount = sTranAmount
FinalBalance = FinalBalance + Val(sTranAmount)
Else
ofxstream.WriteLine (OFX_STMTTRN_TRNTYPE & "DEBIT")
sTranAmount = sTranAmount
FinalBalance = FinalBalance - Val(sTranAmount)
End If
End If

ofxstream.WriteLine (OFX_STMTTRN_DTPOSTED & sTranDate)
ofxstream.WriteLine (OFX_STMTTRN_TRNAMT & sTranAmount)
'Emulated FTID format is date stamp plus transaction number (should be unique)
'Example: "200303170001"
Dim sTranFTID
sTranFTID = Format(dtDatetime, "yyyymmdd") & Format(iTransaction, "0000")
ofxstream.WriteLine (OFX_STMTTRN_FITID & sTranFTID)
ofxstream.WriteLine (OFX_STMTTRN_NAME & sTranName)
If Len(sTranMemo) > 0 Then
ofxstream.WriteLine (OFX_STMTTRN_MEMO & sTranMemo)
End If
ofxstream.WriteLine (OFX_STMTTRN_FOOTER)

'Get next transaction
iTransaction = iTransaction + 1
Wend
ofxstream.WriteLine (OFX_BANKTRANLIST_FOOTER)
'Ledger balance
ofxstream.WriteLine (OFX_LEDGERBAL_HEADER)
ofxstream.WriteLine (OFX_LEDGERBAL_BALAMT & Str(0))
ofxstream.WriteLine (OFX_LEDGERBAL_DTASOF & StatementEndDate)
ofxstream.WriteLine (OFX_LEDGERBAL_FOOTER)

' Write OFX Footer
ofxstream.WriteLine (OFX_STMTRS_FOOTER)
ofxstream.WriteLine (OFX_STMTTRNRS_FOOTER)
ofxstream.WriteLine (OFX_BANKMSGSRSV1_FOOTER)
ofxstream.WriteLine (OFX_FOOTER)
' Close file
ofxstream.Close
End If

End Sub





35 changes: 35 additions & 0 deletions readme.txt
@@ -0,0 +1,35 @@
################
Project: Save As VBA macros for Excel
Purpose: To convert CSV or simple Data in Excel sheet to either CSV or OFX, put simple, easily importable data for WaveApps or other accounting software

Version: 0.1
Date written: 30 Dec 2017

Author: Craig Lambie
Author URI: craiglambie.com

Data:
Generally expects data to be in 3 columns: Date, Description and Amount - could be fiddled with to accommodate more, that is what I have tested

Routines:
SaveAsCSV - saves the current active sheet as a CSV file with the same name as the open file, keeping the data formats
A fork of the code found on this StackOverflow.com question https://stackoverflow.com/questions/37037934/excel-macro-to-export-worksheet-as-csv-file-without-leaving-my-current-excel-sh/37038840

SaveAsOFX - saves the current active sheet as a OFX file with the same name as the open file, with option to save as Credit Card data (the purpose I designed it for) or not
As of version 0.1, this is pretty new.
Borrows heavily on the XLS2OFX Converter v1.0 by Josep Bori, but with many updates and changes, and needs a bunch more, if I have time.
Inspired by the free online converter that takes to long: http://csvconverter.biz/

Usage:
1. Open your Excel file (of any type)
2. Push the data you want to a clean sheet with 3 headers/ top row
3. Go to ribbon View>Macros
4. On dialogue box, dropdown box "Macros in:" select "All Workbooks"
5. Select SaveAsCSV or SaveAsOFX as required
6. Visit the location your excel file is saved to find the CSV or OFX file
7. Done :)

Installation:
1. Open Excel
2. Open VBA (Alt + F11)
3. Import the .cls file

0 comments on commit 0783355

Please sign in to comment.