Serving the Quantitative Finance Community

 
User avatar
rmax
Topic Author
Posts: 374
Joined: December 8th, 2005, 9:31 am

Useful code

January 31st, 2017, 9:42 am

A place to put useful code snippets. I find myself having to reinvent bits of code all the time and hence thought I would place some code here for future reference. If anyone else wants to add, feel free. 

My job nowadays is admin, so most of the stuff I do is VBA , so don't expect me to post something fantastical. However anyone else is free to!
 
User avatar
rmax
Topic Author
Posts: 374
Joined: December 8th, 2005, 9:31 am

Re: Useful code

January 31st, 2017, 9:44 am

Recursive directory print. Requires MS Script RunTime reference
Private Sub PublishFolder(ByVal Path As String)
    
    Dim FS As FileSystemObject
    Dim RootFolder As Folder
    Dim Folder As Folder
    Dim DirType As String
    Dim DirDate As String
    Dim File As File
    Dim Hyperlink As String
    [size=85][font=Helvetica Neue, Helvetica, Arial, sans-serif]   [/font][/size]
    Set FS = New FileSystemObject
    
    Set RootFolder = FS.GetFolder(Path)
    
    For Each Folder In RootFolder.SubFolders
        PublishFolderData (Folder.Path)
    Next
    
    DirType = GetDirType(RootFolder.Name)
    DirDate = GetDirDate(RootFolder.Name)
    
    For Each File In RootFolder.Files
        ' set hyperlink string up
        Hyperlink = "\\SERVERNAME\" & Right(File.Path, Len(File.Path) - 2)
        Debug.Print DirType, Hyperlink, File.Name, DirDate, File.DateCreated
    Next
    
End Sub
 
User avatar
rmax
Topic Author
Posts: 374
Joined: December 8th, 2005, 9:31 am

Re: Useful code

January 31st, 2017, 9:46 am

Arctan2 in VBA
Public Function ArcTan2(Y As Double, X As Double) As Double

    Select Case X
        Case Is > 0
            ArcTan2 = Atn(Y / X)
        Case Is < 0
            ArcTan2 = Atn(Y / X) + PI() * Sgn(Y)
            If Y = 0 Then ArcTan2 = ArcTan2 + PI()
        Case Is = 0
            ArcTan2 = PI() / 2 * Sgn(Y)
    End Select

End Function

Public Function PI() As Double
    
    PI = 3.14159265358979


End Function
 
User avatar
rmax
Topic Author
Posts: 374
Joined: December 8th, 2005, 9:31 am

Re: Useful code

January 31st, 2017, 9:47 am

Great Circle Distance (use PI and ArcTan2 from prior post)
Public Function GreatCircleDistance(Pos1Long As Double, Pos1Lat As Double, Pos2Long As Double, Pos2Lat As Double) As Double
    
    Dim Alpha As Double
    Dim Phi1 As Double
    Dim Phi2 As Double
    Dim Gamma As Double
    Dim DeltaPhi As Double
    Dim DeltaLambda As Double
    
    Const R = 3961  ' earth radius miles
    

    Phi1 = Deg2Rad(Pos1Lat)
    Phi2 = Deg2Rad(Pos2Lat)
    
    DeltaPhi = Phi2 - Phi1
    DeltaLambda = Deg2Rad(Pos2Long) - Deg2Rad(Pos1Long)

    Alpha = Sin(DeltaPhi / 2) * Sin(DeltaPhi / 2) + Cos(Phi1) * Cos(Phi2) * Sin(DeltaLambda / 2) * Sin(DeltaLambda / 2)
    Gamma = 2 * ArcTan2(Sqr(Alpha), Sqr(1 - Alpha))
    
    GreatCircleDistance = R * Gamma

    
End Function