i've been using someone else's code and it works fine except I want to add in a hide sheet portion into one of the if statements so my data tab before i load the data into a table. so that users never see it.
their code is below
Sub GetDataFromBI()
Dim BIReport As CBIReport: Set BIReport = New CBIReport
ThisWorkbook.Sheets("Output").Visible = True
With BIReport
.BIUsername = nBIUsername '-Replace "" with BI Username i.e: "X24UserName"
.BIPassword = nBIPassword '-Replace "" with BI Password i.e: "Password"
.REPORTPATH = MyReportPath
.ReportName = MyReportName
.FilterString = FilterString
.OutputOrigin = ThisWorkbook.Sheets("Output").Range("A1")
.GetData
If Not .IsLoginSuccessful Then MsgBox "Login not successful", vbCritical vbOKOnly:
GoTo CleanExit
If InStr(.LastDownloadStatus, "Success") > 0 Then
MsgBox "Download successful", vbOKOnly
Else
MsgBox "Download not successful", vbCritical vbOKOnly
End If
End With
CleanExit:
Set BIReport = Nothing
End Sub
the login successful variable is just checking that the data downloads successfully from our server and determining the message popup accordingly. what i want to do is hide the output tab if it is an unsuccessful login or download as the output data actually would get loaded into a separate tab later in the code. Therefore I don't want to confuse users to see a tab they would normally not see.
but whenever, i put the thisWorkbook.Sheets("Output").Visible = false portion into the if nots then section it displays the message box even though the download is fine, when the code goes before the msgbox. or if i put it before the go to it triggers the hide and the wider code falls over as i still need this tab for later elements of the code before it is hidden in them.
i have tried to add else segments into the code but can't find where these need to go with the appropriate end if section so i keep getting compile errors.
edit class object code as requested (format odd as i had to cut it for the stack character limit)
'
Option Explicit
' Private contants
' -
Private Const BI_SYSTEM_ROOT As String = "server address" 'hidden for IG reasons
' Private properties
' -
Private iFilterString As String ' The filter to be used for the report
Private iReportPath As String ' The BI folder path (excluding the system root) eg. "/shared/Local/NHSE Monthly Housekeeping Reports/Agreement of Balances (AOB)/AOB Toolkit/Current/"
Private iOutputOrigin As Range ' Range specifying where the QueryTable will be written ' This is the top left cell for the QueryTable
Private iReportName As String ' The name of the report in BI
Private iQueryString As String ' This is the string to use as a connection for the query table (Read-only and redacted if displayed external to the class, see public property QueryString)
Private iHeaderRow As Long ' [Optional] Indicates
Private iLastDownloadStatus As String ' The results of the last download. If the Report has not been downloaded, this will be an empty string
Private iLastDownloadData As Range ' Once a download has completed, this is the range of the downloaded data
Private iLastDownloadTimeTaken As Single ' Number of seconds the last download took to run
Private iLastDownloadErrorMessage As String ' If an error was encountered performing the last download, it will be stored here
Private iBIUsername As String ' The BI username for the user accessing the report
Private iBIPassword As String ' The BI password for the user
Private iCustomColumnSettings As Variant
Private iColumnHeaderRowOffset As Long
Private iSetTextColumnFormats As Variant
Private iIsLoginSuccessful As Boolean
Private Const ERROR_SUCCESS As Long = 0
Private Const BINDF_GETNEWESTVERSION As Long = &H10
Private Const INTERNET_FLAG_RELOAD As Long = &H80000000
' Public properties
' -
' Filter String
Public Property Get FilterString() As String
FilterString = iFilterString
End Property
Public Property Let FilterString(ByVal newFilterString As String)
iFilterString = newFilterString
End Property
' BI Report Folder Path
Public Property Get REPORTPATH() As String
REPORTPATH = iReportPath
End Property
Public Property Let REPORTPATH(ByVal newReportPath As String)
iReportPath = newReportPath
End Property
' QueryTable Output Origin
Public Property Get OutputOrigin() As Range
Set OutputOrigin = iOutputOrigin
End Property
Public Property Let OutputOrigin(ByRef newOutputOrigin As Range)
'Needs to allow an offset of 2 rows to allow rows for title and time/date stamp
If OutputOriginIsValid(newOutputOrigin) Then
Set iOutputOrigin = newOutputOrigin.Offset(2)
Else
RaiseError_InvalidOutputLocation "CBIReport.OutputOrigin_Let"
End If
End Property
' BI Report Name
Public Property Get ReportName() As String
ReportName = iReportName
End Property
Public Property Let ReportName(ByVal newReportName As String)
iReportName = newReportName
End Property
' Last Download Status
Public Property Get IsLoginSuccessful() As Boolean ' Read-only property
IsLoginSuccessful = iIsLoginSuccessful
End Property
' Last Download Status
Public Property Get LastDownloadStatus() As String ' Read-only property
LastDownloadStatus = iLastDownloadStatus
End Property
' Last Download Time Taken (in seconds)
Public Property Get LastDownloadTimeTaken() As Single ' Read-only property
LastDownloadTimeTaken = iLastDownloadTimeTaken
End Property
' BI Username
Public Property Let BIUsername(ByVal newBIUsername As String) ' Write-only property
iBIUsername = newBIUsername
End Property
' BI Password
Public Property Let BIPassword(ByVal newBIPassword As String) ' Write-only property
iBIPassword = newBIPassword
End Property
' Query String (connection string)
Public Property Get QueryString() As String ' Read-only property
BuildQueryString 'False, False
QueryString = iQueryString
RemovePasswordFromString QueryString
End Property
' Error message (if any) from the last download
Public Property Get LastDownloadErrorMessage() As String ' Read-only property
LastDownloadErrorMessage = iLastDownloadErrorMessage
RemovePasswordFromString LastDownloadErrorMessage
End Property
Public Property Let SetTextColumnFormats(ByRef newSetTextColumnFormats As Variant)
iSetTextColumnFormats = newSetTextColumnFormats
End Property
Public Property Get SetTextColumnFormats() As Variant
SetTextColumnFormats = iSetTextColumnFormats
End Property
' Public methods
' -
Public Sub GetData(Optional IsPFMS As Boolean = False, Optional AddAutoFilter As Boolean = True)
Dim DownloadTimer As Single
On Error GoTo ErrorTrap
iLastDownloadTimeTaken = Timer() - DownloadTimer
'Start Timer
DownloadTimer = Timer() ' Start timing how long the download takes
'Check parameters are valid ProposedConnectionIsValid
If Not ProposedConnectionIsValid() Then
RaiseError_BadParameters "GetData"
End If
'Reset Variable Stats ResetLastDownloadVariables
ResetLastDownloadVariables
'Build Query String BuildQueryString
BuildQueryString
'Delete data on output sheet PrepareQueryTableLocation
PrepareQueryTableLocation IsPFMS
CreateDirDownloadFileRefreshQuery
'Convert text to columns ConvertDataToColumns
ConvertDataToColumns
'Add date stamp and file name to sheet AddDateStampAndReportName
AddDateStampAndReportName
'Check data imported successfully
'Check Is not incorrect login
If IsIncorrectLogin Then
' If the download completed but the login details are incorrect, error out
iIsLoginSuccessful = False
RaiseError_UnableToLogIn "DownloadIsSuccessful"
End If
'Report if download was success or failure
'Add Autofilter AddAutoFilterToData
If AddAutoFilter Then AddAutoFilterToData
CleanExit:
'Delete all connections DeleteAllConnections
DeleteAllConnections
'Delete external ranges DeleteExternalDataNamedRanges
DeleteExternalDataNamedRanges
If Not (iOutputOrigin Is Nothing) Then
If DownloadIsSuccessful Then
iLastDownloadStatus = "Success: " & Format(Now(), "dd/mm/yyyy hh:mm:ss") & " [" & Environ("username") & "]"
Else
iLastDownloadStatus = "Failed: " & Format(Now(), "dd/mm/yyyy hh:mm:ss") & " [" & Environ("username") & "]"
End If
Else
iLastDownloadStatus = "Failed: " & Format(Now(), "dd/mm/yyyy hh:mm:ss") & " [" & Environ("username") & "]"
End If
'Stop Timer
iLastDownloadTimeTaken = Timer() - DownloadTimer
Exit Sub
ErrorTrap:
Dim ErrorMessage As String
ErrorMessage = Err.Number & " - " & Err.Description
iLastDownloadErrorMessage = ErrorMessage
Err.Clear
' Simply allow the method to exit - DownloadIsSuccessful will report failure if the download failed
' and the error message will be accessible through the object model as property LastDownloadErrorMessage
Resume CleanExit
End Sub
'
' Private methods
' -
Private Sub ResetLastDownloadVariables()
' This method resets the Last Download methods, clearing them for a fresh download
iLastDownloadStatus = vbNullString
Set iLastDownloadData = Nothing
iLastDownloadTimeTaken = 99999 ' reset to a large number rather than zero, to handle quick reports that might take less than a second
iLastDownloadErrorMessage = vbNullString
End Sub
Private Sub BuildQueryString() 'ByVal GetTop1 As Boolean, ByVal RunAsCSV As Boolean)
'Build full query string using BI username, BI password, BI report name and FilterString
'Format should be csv
'BI password and Report name will need to use EncodeForURL
Dim QueryString As String
QueryString = QueryString & BI_SYSTEM_ROOT & "?Go"
QueryString = QueryString & "&NQUser=" & iBIUsername & "&NQPassword=" & EncodeForURL(iBIPassword)
' Folder path in BI
QueryString = QueryString & "&Action=Extract&Path=" & EncodeForURL(iReportPath)
' Report name in BI
QueryString = QueryString & EncodeForURL(iReportName)
' Download format
QueryString = QueryString & "&Format=csv"
' Filter string (if any)
QueryString = QueryString & iFilterString
' Update the internal string
iQueryString = QueryString
End Sub
Private Sub PrepareQueryTableLocation(Optional ByVal IsPFMS As Boolean = False)
'Unhide columns
'Turn filter off
'Delete data - For PFMS wb not all data will be deleted, range will need resizing. Boolean used to specify if wb/ws is PFMS type
Dim RangeToDelete As Range
Dim TempRangeAddress As String
Dim TempRangeSheet As String
TempRangeAddress = iOutputOrigin.Address ' Temporarily hold iOutputOrigin in case it is deleted if all the cells on the sheet are deleted (default case)
TempRangeSheet = iOutputOrigin.Parent.Name
' Set what range to delete based on PFMS setting
If IsPFMS Then
With iOutputOrigin.Parent.Cells
Set RangeToDelete = .Resize(.Rows.Count - 1, .Columns.Count - 1).Offset(1, 1)
End With
Else
Set RangeToDelete = iOutputOrigin.Parent.Cells
End If
' Unhide any columns in the target sheet
iOutputOrigin.Parent.Columns.EntireColumn.Hidden = False
' Remove filters
If iOutputOrigin.Parent.FilterMode Then
iOutputOrigin.Parent.AutoFilterMode = False
End If
RangeToDelete.Rows.Clear
' Reset the iOutputOrigin internal parameters, as this will be deleted (and return an error) if all cells on the sheet
' are deleted
Set iOutputOrigin = ThisWorkbook.Sheets(TempRangeSheet).Range(TempRangeAddress)
Set RangeToDelete = Nothing
End Sub
Private Sub CreateDirDownloadFileRefreshQuery()
Dim CSVPath As String
Dim NHSEICacheFolder As String: CCacheFolder = Environ("AppData") & "\C"
Dim newQueryTable As QueryTable
Dim Retry As Long
'Create folder Dir if does not exist
If Len(Dir(NHSEICacheFolder, vbDirectory)) = 0 Then
MkDir CCacheFolder
End If
CSVPath = CCacheFolder & "\csv_download.csv"
'Delete temporary file if it exists
If Len(Dir(CSVPath)) > 0 Then
Kill CSVPath
End If
DoEvents
'Add query table
'Refresh query table
'Check refresh successful
Do
ResetTextToColumns
'Download file DownloadFile
'Check download was successful - Download return boolean
If Not DownloadFile(iQueryString, CSVPath) Then
RaiseError_UnableToDownloadData "CreateDirDownloadFileRefreshQuery"
End If
' Apply parameters to QueryTable
' Note - place the data two rows below the Output origin, to allow for the Title and Date/Time to be added
Set newQueryTable = iOutputOrigin.Parent.QueryTables.Add( _
Connection:="TEXT;" & CSVPath, _
Destination:=iOutputOrigin)
With newQueryTable
.BackgroundQuery = False
.TablesOnlyFromHTML = True
.RefreshStyle = xlOverwriteCells
.Refresh BackgroundQuery:=False
DoEvents
Retry = Retry 1 ' Prevent infinite loops from occurring when server cannot be found
' This happens because in this situation, nothing is returned by the report, effectively
' leaving the output sheet blank. Therefore, IsSigningIn can't tell the difference and will cause this
' loop to run indefinitely.
End With
Loop Until (Not IsSigningIn) Or Retry > 10
End Sub
Private Sub ResetTextToColumns()
'Used to avoid Excel automatically applying TextToColumns
With iOutputOrigin
.Value2 = "Reset"
.TextToColumns _
Destination:=iOutputOrigin, _
DataType:=xlDelimited, _
ConsecutiveDelimiter:=False, _
Tab:=False, _
Semicolon:=False, _
Comma:=False, _
Space:=False, _
other:=False
End With
End Sub
Private Sub ConvertDataToColumns()
'Store custom column formats in variant - cycle through each heading
'Unless user specifies column formats the format should be xlGeneral except for A2 code which should be text
'If data is comma delimited then Convert text to columns else apply column formats
'Autofit columns
' This method will process a new CSV download by converting the single column data using TextToColumns
' using a defined configuration for the column formats. Where no defined configuration has been set,
' a default configuration of 'General' format will be used for each colummn
Dim CustomColumnFormats As Variant
Dim OldDisplayAlerts As Boolean
CustomColumnFormats = GetCustomColumnFormats()
OldDisplayAlerts = Application.DisplayAlerts
Application.DisplayAlerts = False
With iOutputOrigin
.CurrentRegion.Columns(1).TextToColumns _
Destination:=iOutputOrigin, _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, _
Semicolon:=False, _
Comma:=True, _
Space:=False, _
other:=False, _
FieldInfo:=CustomColumnFormats, _
TrailingMinusNumbers:=True
Application.DisplayAlerts = OldDisplayAlerts
.CurrentRegion.EntireColumn.AutoFit
' Amend the first row heading as this contains a relic from the data download
.Value2 = Replace(iOutputOrigin.Value2, "", "")
End With
End Sub
Private Sub AddAutoFilterToData()
'Add filter to header row after data has been imported
' Once the downlaod is run, this method will add an autofilter to the dataset, using iCokumnHeaderOffset to identify
' which row to add the filter to
On Error GoTo ErrorHandler
with iOutputOrigin
.Resize(1, iOutputOrigin.CurrentRegion.Columns.Count).AutoFilter
.Parent.Activate
End With
' Also add a freeze-panes so that the header row stays at teh top
With ActiveWindow
If .FreezePanes Then .FreezePanes = False
iOutputOrigin.Select
.SplitColumn = 0
.SplitRow = iOutputOrigin.Row
.FreezePanes = True
End With
ErrorHandler:
End Sub
Private Sub AddDateStampAndReportName()
'Add report name and today's date
' Note - using the Offset should never cause an error, because when OutputOrigin is set, the value of iOutputOrigin is set to two cells below
With iOutputOrigin
With .Offset(-2, 0)
.Value2 = ReportName
.Font.Bold = True
End With
With .Offset(-1, 0)
.Value2 = "Time run: " & Format(Now(), "dd/mm/yyyy hh:mm:ss")
.EntireRow.RowHeight = 25
.VerticalAlignment = xlCenter
End With
End With
End Sub
Private Sub DeleteAllConnections()
'Delete all external connections
Dim ConnectionToDelete As Variant
On Error Resume Next ' brute force approach
For Each ConnectionToDelete In ThisWorkbook.Connections
ConnectionToDelete.Delete
Next ' ConnectionToDelete
Set ConnectionToDelete = Nothing
End Sub
Private Sub DeleteExternalDataNamedRanges()
' Deletes all named ranges with names containing the string "ExternalData".
' These named ranges are created automatically when a QueryTable is created, and they
' need to be removed as they serve no purpose
Dim NameToDelete As Name
For Each NameToDelete In ThisWorkbook.Names
If InStr(NameToDelete.Name, "ExternalData") > 0 Then
NameToDelete.Delete
End If
Next ' NameToDelete
Set NameToDelete = Nothing
End Sub
Private Sub RemovePasswordFromString(ByRef TextToRedact As String)
' This method removes the password from a given string.
' The method operates on the string itself (ByRef) so there is no return value.
' Usage: RedactPasswordFromString strConnectionString
Dim temp As String
temp = iBIPassword
TextToRedact = Replace(TextToRedact, temp, "[Redacted]")
temp = EncodeForURL(temp)
TextToRedact = Replace(TextToRedact, temp, "[Redacted]")
End Sub
Private Sub RaiseError_BadParameters(ByVal ProcedureName As String)
' Error 101 - Bad parameters
' Wrapper for raising an error where the parameters are found to be invalid
Err.Raise 101 vbObjectError, ProcedureName, "Unable to link to BI report. Check that all CBIReport parameters are set correctly."
End Sub
Private Sub RaiseError_UnableToConnect(ByVal ProcedureName As String)
' Error 102 - Failure to connect
' Wrapper for raising an error where the parameters are found to be invalid
Err.Raise 102 vbObjectError, ProcedureName, "Unable to create a connection to ISFE BI. Check network connection and server availability."
End Sub
Private Sub RaiseError_UnableToLogIn(ByVal ProcedureName As String)
' Error 103 - Failure to log in
' Wrapper for raising an error where the parameters are found to be invalid
Err.Raise 103 vbObjectError, ProcedureName, "Unable to log in to ISFE BI. Check username and password and try again."
End Sub
Private Sub RaiseError_InvalidOutputLocation(ByVal ProcedureName As String)
' Error 104 - Failure to validate Output location for BI report
' Wrapper for raising an error where the parameters are found to be invalid
Err.Raise 104 vbObjectError, ProcedureName, "Unable to create a BI report at the specified location - location is invalid."
End Sub
Private Sub RaiseError_InvalidDownloadFromat(ByVal ProcedureName As String)
' Error 105 - Failure to recognise specified download format
' Wrapper for raising an error where specified download format is not recognised as one of the configured DownloadFormats
Err.Raise 105 vbObjectError, ProcedureName, "Unable to identify download format - please choose one of the configured formats DownloadFormats"
End Sub
Private Sub RaiseError_UndefinedCustomColumnFormat(ByVal ProcedureName As String)
' Error 106 - Failure to recognise specified download format
' Wrapper for raising an error where specified download format is not recognised as one of the configured DownloadFormats
Err.Raise 106 vbObjectError, ProcedureName, "Unable to identify custom column data format - choose one from xlColumnDataType"
End Sub
Private Sub RaiseError_UnableToDownloadData(ByVal ProcedureName As String)
' Error 106 - Failure to recognise specified download format
' Wrapper for raising an error where specified download format is not recognised as one of the configured DownloadFormats
Err.Raise 107 vbObjectError, ProcedureName, "Unable to download data"
End Sub
Private Function DownloadFile(ByVal SourceURL As String, ByVal LocalFile As String) As Boolean
'Download the file. BINDF_GETNEWESTVERSION forces the API to download from the specified source.
'Passing 0& as dwReserved causes the locally-cached copy to be downloaded, if available. If the API
'returns ERROR_SUCCESS (0), DownloadFile returns True.
' DownloadFile = URLDownloadToFile(0&, SourceURL, LocalFile, BINDF_GETNEWESTVERSION, 0&) = ERROR_SUCCESS
Dim WinHttpReq As Object: Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", SourceURL, False
WinHttpReq.send
If WinHttpReq.Status = 200 Then
Dim oStream As Object: Set oStream = CreateObject("ADODB.Stream")
With oStream
.Open
.Type = 1
.Write WinHttpReq.responseBody
.SaveToFile LocalFile, 2
.Close
DownloadFile = Len(Dir(LocalFile)) > 0
Exit Function
End With ' oStream
End If
End Function
Private Function GetCustomColumnFormats() As Variant
'Cycle through each heading in the data set and specify if it's:
'xlTextFormat or xlGeneralFormat
'If column is Analysis2 code then specify column as xlTextFormat
'Use GetColumnFormatSetting
'Incorporate any custom column formats by the user CustomSettingsExist
' Check if custom column formats have been set, if so, return them in a format suitable for TexttoColumns FieldInfo
' If not, then check the data set for the number of columns, then create an array to return where all
' column formats are the default General
Dim result() As Variant
Dim t As Long
For t = 0 To GetNumberOfColumnsInDataset() - 1
ReDim Preserve result(t)
If ColumnIsAnalysis2Code(t) Then
result(t) = GetColumnFormatSetting(t 1, XlColumnDataType.xlTextFormat)
ElseIf IsCustomTextSetting(t) Then
result(t) = GetColumnFormatSetting(t 1, XlColumnDataType.xlTextFormat)
ElseIf ColumnIsCCCode(t) Then
result(t) = GetColumnFormatSetting(t 1, XlColumnDataType.xlTextFormat)
ElseIf ColumnIsAnalysis1Code(t) Then
result(t) = GetColumnFormatSetting(t 1, XlColumnDataType.xlTextFormat)
Else
result(t) = GetColumnFormatSetting(t 1, XlColumnDataType.xlGeneralFormat)
End If
Next t
GetCustomColumnFormats = result
End Function
Private Function GetColumnFormatSetting(ByVal ColumnNumber As Long, ByVal ColumnFormat As XlColumnDataType) As Variant
'Add Array to GetColumnFormatSetting
GetColumnFormatSetting = Array(ColumnNumber, ColumnFormat)
End Function
Private Function IsCustomTextSetting(ByVal ColNumber As Long) As Boolean
'if SetTextColumnFormats is not empty then TRUE
Dim t As Long
If IsArray(iSetTextColumnFormats) Then
For t = 0 To UBound(iSetTextColumnFormats)
If iSetTextColumnFormats(t) = ColNumber Then
IsCustomTextSetting = True
End If
Next t
End If
End Function
Private Function GetNumberOfColumnsInDataset() As Long
'if data imported is in comma delimited format count comma's else count number of columns with a heading/data
Dim TestString As String
TestString = iOutputOrigin.Value2
GetNumberOfColumnsInDataset = Len(TestString) - Len(Replace(TestString, ",", "")) 1 ' Count the number of commas in the first cell and add 1 to get the number of columns
End Function
Private Function ColumnIsAnalysis2Code(ByVal ColumnOffset As Long) As Boolean
Dim HeaderText() As String
HeaderText = Split(iOutputOrigin.Value2, ",")
If Replace(HeaderText(ColumnOffset), "", "") = "Analysis 2 Code" Or _ Replace(HeaderText(ColumnOffset), "", "") = "Analysis Two Code" Then
ColumnIsAnalysis2Code = True
End If
End Function
Private Function ColumnIsCCCode(ByVal ColumnOffset As Long) As Boolean
Dim HeaderText() As String
HeaderText = Split(iOutputOrigin.Value2, ",")
If Replace(HeaderText(ColumnOffset), "", "") = "Cost Centre code" Or _
Replace(HeaderText(ColumnOffset), "", "") = "Cost centre code" Then
ColumnIsCCCode = True
End If
End Function
Private Function ColumnIsAnalysis1Code(ByVal ColumnOffset As Long) As Boolean
Dim HeaderText() As String
HeaderText = Split(iOutputOrigin.Value2, ",")
If Replace(HeaderText(ColumnOffset), "", "") = "Analysis 1 Code" Or _
Replace(HeaderText(ColumnOffset), "", "") = "Analysis One Code" Then
ColumnIsAnalysis1Code = True
End If
End Function
Private Function EncodeForURL(ByVal URLString As String, Optional SpaceAsPlus As Boolean = False) As String
' %-encodes all escapbale characters within the passed URLString, allowing special characters to be
' safely used as part of a BI password, whcih passed through a URL
' Works on the Parameter BYVAL
Dim StringLen As Long: StringLen = Len(URLString)
If StringLen > 0 Then
ReDim result(StringLen) As String
Dim i As Long
Dim CharCode As Integer
Dim Char As String
Dim Space As String
If SpaceAsPlus Then Space = " " Else Space = " "
For i = 1 To StringLen
Char = Mid$(URLString, i, 1)
CharCode = Asc(Char)
Select Case CharCode
Case 97 To 122 '-Lower case a to z
result(i) = Char
Case 65 To 90 '-Upper case A to Z
result(i) = Char
Case 48 To 57 '-Numeric 0 to 9
result(i) = Char
Case 45, 46, 95, 126 '45="-", 46=".", 95="_", 126="~"
result(i) = Char
Case 32 '-Space character " "
result(i) = Space
Case 0 To 15
result(i) = "%0" & Hex(CharCode)
Case Else
result(i) = "%" & Hex(CharCode)
End Select
Next i
EncodeForURL = Join(result, "")
End If
End Function
Private Function DownloadIsSuccessful() As Boolean
'Check if output origin is vbnullstring
If iOutputOrigin.Value2 <> vbNullString And iOutputOrigin.Value2 <> "Reset" Then
DownloadIsSuccessful = True
End If
End Function
Private Function ProposedConnectionIsValid() As Boolean
'Check Output Origin
'Check BI Report Path
'Check Report Name
'Check for BIUsername
'Check for BIPassword
'Check Output Origin
If Not OutputOriginIsValid(iOutputOrigin) Then
Exit Function
End If
' Check BI Report Path
If Len(iReportPath) = 0 Then
Exit Function
End If
' Check Report Name
If Len(iReportName) = 0 Then
Exit Function
End If
' Check for BIUsername
If Len(iBIUsername) = 0 Then
Exit Function
End If
' Check for BIPassword
If Len(iBIPassword) = 0 Then
Exit Function
End If
ProposedConnectionIsValid = True
End Function
Private Function OutputOriginIsValid(ByRef OutputOrigin As Range) As Boolean
' This function checks if the proposed Output origin is valid.
' Validity is defined by:
' - range is a single cell
' Returns TRUE for valid, FALSE for not valid (default)
If OutputOrigin Is Nothing Then
Exit Function
End If
If OutputOrigin.Cells.Count = 1 Then
OutputOriginIsValid = True
End If
End Function
Private Function IsSigningIn() As Boolean 'ByRef ReportSheet As Worksheet) As Boolean
Dim rngTest As Range
For Each rngTest In iOutputOrigin.Parent.Range("A1:D55")
If InStr(rngTest.Value, "Signing in...") > 0 Or InStr(rngTest.Value, "Oracle Logo") Then
IsSigningIn = True
GoTo CleanExit
End If
Next rngTest
IsSigningIn = False
CleanExit:
Set rngTest = Nothing
End Function
Private Function IsIncorrectLogin() As Boolean 'ByRef ReportSheet As Worksheet) As Boolean
Dim rngTest As Range
For Each rngTest In iOutputOrigin.Parent.Range("A1:D55")
If InStr(rngTest.Value, "Unable to Sign In") > 0 Then
IsIncorrectLogin = True
GoTo CleanExit
End If
Next rngTest
IsIncorrectLogin = False
CleanExit:
Set rngTest = Nothing
End Function
Private Sub Class_Initialize()
ResetLastDownloadVariables
iIsLoginSuccessful = True
End Sub
CodePudding user response：
the ":" is to merge many statements on a single line
Instead of this statement
If Not .IsLoginSuccessful Then MsgBox "Login not successful", vbCritical vbOKOnly:
GoTo CleanExit '<-- This will be executed regardless of the previous If condition. So your code will hit Goto statement everytime.
Try this
If Not .IsLoginSuccessful Then
MsgBox "Login not successful", vbCritical vbOKOnly
ThisWorkbook.Sheets("Output").Visible = false
GoTo CleanExit
End if
CodePudding user response：
You can try this
If Not .IsLoginSuccessful Then
MsgBox "Login not successful", vbCritical vbOKOnly
thisWorkbook.Sheets("Output").Visible = false
GoTo CleanExit
End If
If InStr(.LastDownloadStatus, "Success") > 0 Then
MsgBox "Download successful", vbOKOnly
Else
MsgBox "Download not successful", vbCritical vbOKOnly
End If
Correct me if it is not the position you want to add that line, as I'm new member, I'm unable to comment, that's why posted directly without confirming.
if you want that somewhere else, then say it, I'll try to solve it.