Add files via upload

Author: zq99

OpenAIFrameworkDemo.xlsm

@@ -0,0 +1,15 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "ThisWorkbook"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = True
+Option Explicit
+
+Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
+    ThisWorkbook.Saved = True
+End Sub
+

ThisWorkbook.cls

@@ -45,6 +45,10 @@ Private mobjRequest As clsOpenAIRequest
 'Open AI defined constants
 Private Const API_ENDPOINT_CHAT As String = "https://api.openai.com/v1/chat/completions"
 Private Const API_ENDPOINT_COMPLETIONS As String = "https://api.openai.com/v1/completions"
+Private Const API_ENDPOINT_IMAGE_CREATION As String = "https://api.openai.com/v1/images/generations"
+
+Private Const DEFAULT_LOCAL_LOCATION As String = "C:\Users\Public\Downloads\"
+Private mstrFolderToSave As String
 
 'More models can be found here: https://platform.openai.com/docs/models/overview
 Private Const DEFAULT_CHAT_MODEL As String = "gpt-3.5-turbo"
@@ -102,6 +106,14 @@ Public Property Let PresencePenalty(ByVal value As Double)
     mobjRequest.PresencePenalty = value
 End Property
 
+Public Property Let FolderToSaveTo(ByVal value As String)
+    mstrFolderToSave = value
+End Property
+
+Public Property Get FolderToSaveTo() As String
+    FolderToSaveTo = mstrFolderToSave
+End Property
+
 
 Public Sub IsLogOutputRequired(ByVal value As Boolean)
 'Purpose: Calling routines can switch off messages in this framework from appearing in the Immediate window
@@ -122,7 +134,7 @@ Public Sub Log(ByVal strMessage As String)
 End Sub
 
 
-Private Function GetResponseFromAPI(ByVal strRequestJson As String, ByVal strEndPoint As String) As clsOpenAIResponse
+Private Function GetResponseFromAPI(ByVal strRequestJson As String, ByVal strEndPoint As String, Optional ByVal strLocalPath As String = DEFAULT_LOCAL_LOCATION) As clsOpenAIResponse
 'Purpose: This handles the request to OpenAI's API URL
 
     Dim strResponseJson As String
@@ -142,37 +154,43 @@ On Error GoTo ERR_HANDLER:
         .Open "POST", strEndPoint, False
         .SetRequestHeader "Content-Type", "application/json"
         .SetRequestHeader "Authorization", "Bearer " & mstrAPI_KEY
-        .send (strRequestJson)
+        .Send (strRequestJson)
     End With
 
-    ' completed
+    ' unblock other processes if still querying OpenAI
     Do While mobjHttpRequest.readyState <> HTTP_REQUEST_COMPLETED
         DoEvents
     Loop
-    
-    Log "Response code from OpenAI API is: " & mobjHttpRequest.Status
 
     If mobjHttpRequest.Status = HTTP_STATUS_OK Then
 
         'get the json result from the successful request
-        strResponseJson = Trim(mobjHttpRequest.responseText)
+        strResponseJson = Trim(mobjHttpRequest.ResponseText)
         Log strResponseJson
-        Set oResponse = New clsOpenAIResponse
 
         'format the json result according to which api endpoint used
         If strEndPoint = API_ENDPOINT_CHAT Then
 
             'ChatGPT and GPT4
+            Set oResponse = New clsOpenAIResponse
             oResponse.ParseChatJSON (strResponseJson)
             Set GetResponseFromAPI = oResponse
 
         ElseIf strEndPoint = API_ENDPOINT_COMPLETIONS Then
 
             'GPT3 and earlier
+            Set oResponse = New clsOpenAIResponse
             oResponse.ParseTextCompletionJSON (strResponseJson)
             Set GetResponseFromAPI = oResponse
 
+        ElseIf strEndPoint = API_ENDPOINT_IMAGE_CREATION Then
+        
+            'DALL-E image generator
+            Set GetResponseFromAPI = GetResponseObjectForImageParse(strResponseJson)
+        
         End If
+    Else
+        mobjLogger.PrintCriticalMessage ("Failed to retrieve data from OpenAI. Response code is " & mobjHttpRequest.Status)
     End If
 
 EXIT_HERE:
@@ -185,6 +203,56 @@ ERR_HANDLER:
 End Function
 
 
+Private Function GetResponseObjectForImageParse(ByVal strResponseJson As String)
+    
+    Set GetResponseObjectForImageParse = Nothing
+    
+    Dim oResponse As clsOpenAIResponse
+    Dim strImageUrl As String
+    
+    Set oResponse = New clsOpenAIResponse
+    strImageUrl = oResponse.GetImageURLFromImageCreationJSON(strResponseJson)
+    
+    If Len(strImageUrl) > 0 Then
+
+        Dim strFileName As String
+        strFileName = oResponse.GetFileNameFromImageURL(strImageUrl)
+        
+        If Len(strFileName) > 0 Then
+        
+            Dim strFullName As String
+            strFullName = mstrFolderToSave & strFileName
+            
+            If Not mobjHttpRequest Is Nothing Then
+            
+                mobjHttpRequest.Open "GET", strImageUrl, False
+                mobjHttpRequest.Send
+                
+                'convert the byte array to a saved image file
+
+                Dim objStream As Object
+                Set objStream = CreateObject("ADODB.Stream")
+                
+                If Not objStream Is Nothing Then
+                    objStream.Open
+                    objStream.Type = 1
+                    objStream.write mobjHttpRequest.ResponseBody
+                    objStream.SaveToFile strFullName
+                    objStream.Close
+                    Set objStream = Nothing
+                    
+                    If Len(Dir(strFullName)) > 0 Then
+                       oResponse.SavedLocalFile = strFullName
+                    End If
+                    Set GetResponseObjectForImageParse = oResponse
+                End If
+            End If
+        End If
+    End If
+    Set oResponse = Nothing
+End Function
+
+
 Private Function IsAPIKeyValid() As Boolean
 'Purpose: Check a valid API key has been assigned
 
@@ -264,6 +332,8 @@ Private Sub Class_Initialize()
     mobjLogger.IsMessageRequired = False
     mobjLogger.SetClass Me
 
+    mstrFolderToSave = DEFAULT_LOCAL_LOCATION
+    
     mstrAPI_KEY = Empty
 
 End Sub
@@ -289,6 +359,8 @@ Private Function GetDefaultRequestSettings() As clsOpenAIRequest
         .Temperature = 0.5
         .FrequencyPenalty = 0
         .PresencePenalty = 0
+        .ImageHeight = 256
+        .ImageWidth = 256
     End With
     Set GetDefaultRequestSettings = oRequest
 
@@ -303,6 +375,7 @@ Public Sub ClearSettings()
 
 End Sub
 
+
 Public Function GetReadAPIKeyFromFolder(ByVal strfolderPath As String) As String
 'Purpose: Allows retrieval of an API KEY saved in an external file (possibly stored on a drive only the current user can access)
 
@@ -328,3 +401,27 @@ Public Function GetReadAPIKeyFromFolder(ByVal strfolderPath As String) As String
 End Function
 
 
+Public Function CreateImageFromText(ByVal strPrompt As String, ByVal lngWidth As Long, ByVal lngHeight As Long) As clsOpenAIResponse
+'Purpose: This is for OpenAI's image creation
+
+    Set CreateImageFromText = Nothing
+
+    If Not IsAPIKeyValid Then
+        mobjLogger.PrintCriticalMessage MESSAGE_INVALID_API_KEY, True
+        Exit Function
+    End If
+    
+    If mobjHttpRequest Is Nothing Or strPrompt = Empty Then
+        Exit Function
+    End If
+    
+    mobjRequest.prompt = strPrompt
+    mobjRequest.ImageHeight = lngHeight
+    mobjRequest.ImageWidth = lngWidth
+    
+    Log mobjRequest.GetDalleImageSendToAPIJsonString
+    
+    Set CreateImageFromText = GetResponseFromAPI(mobjRequest.GetDalleImageSendToAPIJsonString, API_ENDPOINT_IMAGE_CREATION, DEFAULT_LOCAL_LOCATION)
+
+End Function
+

clsOpenAI.cls

@@ -40,6 +40,7 @@ Private mobjClass As IOpenAINameProvider
 
 Private mblnIsMessageRequired As Boolean
 
+
 Private Function IOpenAINameProvider_GetClassName() As String
     IOpenAINameProvider_GetClassName = "clsOpenAILogger"
 End Function
@@ -64,6 +65,7 @@ Public Sub SetClass(ByVal Obj As IOpenAINameProvider)
     Set mobjClass = Obj
 End Sub
 
+
 Public Sub PrintMessage(ParamArray vntMessage() As Variant)
 ' Purpose: Takes in an open ended list of string variables and appends then together as a message to
 '          output to the immediate window
@@ -85,6 +87,7 @@ Public Sub PrintMessage(ParamArray vntMessage() As Variant)
 
 End Sub
 
+
 Private Sub LogMessage(ByVal strMessage As String)
 'Purpose: The main logging routine for messages, which can be suppressed by calling routines
 
@@ -95,6 +98,7 @@ Private Sub LogMessage(ByVal strMessage As String)
     End If
 End Sub
 
+
 Public Sub PrintCriticalMessage(ByVal strMessage As String, Optional ByVal blnIsBorderRequired As Boolean = False, Optional ByVal strBorderCharacter As String = "*", Optional ByVal blnAddModuleName As Boolean = True, Optional ByVal strLabel As String = "WARNING")
 'Purpose: This method always outputs to the immediate window regardless of whether logging is set to False
 
@@ -120,7 +124,7 @@ Public Sub PrintCriticalMessage(ByVal strMessage As String, Optional ByVal blnIs
 End Sub
 
 
-Public Sub PrintVBAError(ByVal objErr As Error)
+Public Sub PrintVBAError(ByVal objErr As ErrObject)
 'Purpose: This method always outputs to the immediate window regardless of whether logging is set to False
 
     If Not mobjClass Is Nothing Then
@@ -134,6 +138,7 @@ Public Sub PrintVBAError(ByVal objErr As Error)
 
 End Sub
 
+
 Private Function fncGetDateTimeStamp() As String
 'Purpose: All logged messages are outputted with a time stamp unless caling functions suppress this
     fncGetDateTimeStamp = Format(Now, "yyyy-MM-dd hh:mm:ss")

clsOpenAILogger.cls

@@ -39,9 +39,9 @@ Implements IOpenAINameProvider
 
 Private mstrRole As String
 Private mstrContent As String
-
 Private mcollMessageParts As Collection
 
+
 Private Function IOpenAINameProvider_GetClassName() As String
     IOpenAINameProvider_GetClassName = "clsOpenAIMessage"
 End Function
@@ -50,10 +50,12 @@ Private Function IOpenAINameProvider_ToString() As String
     IOpenAINameProvider_ToString = GetMessageContentString()
 End Function
 
+
 Private Sub Class_Initialize()
     Set mcollMessageParts = New Collection
 End Sub
 
+
 Private Sub Class_Terminate()
     Set mcollMessageParts = Nothing
 End Sub

clsOpenAIMessage.cls

@@ -39,6 +39,7 @@ Implements IOpenAINameProvider
 
 Private mcollMessages As Collection
 
+
 Private Function IOpenAINameProvider_GetClassName() As String
     IOpenAINameProvider_GetClassName = "clsOpenAIMessages"
 End Function
@@ -47,24 +48,29 @@ Private Function IOpenAINameProvider_ToString() As String
     IOpenAINameProvider_ToString = GetAllMessages
 End Function
 
+
 Private Sub Class_Initialize()
     Set mcollMessages = New Collection
 End Sub
 
+
 Private Sub Class_Terminate()
     Set mcollMessages = Nothing
 End Sub
 
+
 Public Sub AddMessage(ByVal objMsg As clsOpenAIMessage)
     mcollMessages.Add objMsg
 End Sub
 
+
 Public Sub ClearMessages()
     If Not mcollMessages Is Nothing Then
         mcollMessages.Clear
     End If
 End Sub
 
+
 Public Function GetAllMessages() As String
 'Purpose: This builds a string of all messages that will be sent to OpenAI API
 
@@ -95,6 +101,7 @@ Public Function GetAllMessages() As String
 
 End Function
 
+
 Private Function GetMessageObject(ByVal strKeyName As String, ByVal strKey As String, ByVal strValueName As String, ByVal strValue As String) As clsOpenAIMessage
 'Purpose: Helper routine to construct known message object types
 
@@ -108,22 +115,27 @@ Private Function GetMessageObject(ByVal strKeyName As String, ByVal strKey As St
 
 End Function
 
+
 Public Sub AddUserMessage(ByVal strContent As String)
     Call Me.AddMessage(GetMessageObject("role", "user", "content", strContent))
 End Sub
 
+
 Public Sub AddSystemMessage(ByVal strContent As String)
     Call Me.AddMessage(GetMessageObject("role", "system", "content", strContent))
 End Sub
 
+
 Public Sub AddAssistantMessage(ByVal strContent As String)
     Call Me.AddMessage(GetMessageObject("role", "assistant", "content", strContent))
 End Sub
 
+
 Public Sub AddCustomMessage(ByVal strKeyName As String, ByVal strKeyValue As String, ByVal strValueName As String, ByVal strValue As String)
     Call Me.AddMessage(GetMessageObject(strKeyName, strKeyValue, strValueName, strValue))
 End Sub
 
+
 Public Function GetTotal() As Integer
     If Not mcollMessages Is Nothing Then
         GetTotal = mcollMessages.Count