我一直在使用別人的代碼，它作業正常，除了我想在其中一個 if 陳述句中添加一個隱藏作業表部分，以便在我將資料加載到表中之前我的資料選項卡。讓用戶永遠看不到它。
他們的代碼如下
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
登錄成功變數只是檢查資料是否從我們的服務器成功下載并相應地確定訊息彈出視窗。我想要做的是隱藏輸出選項卡，如果它是不成功的登錄或下載，因為輸出資料實際上會在稍后的代碼中加載到單獨的選項卡中。因此，我不想讓用戶混淆他們通常看不到的標簽。
但是無論何時，我將thisWorkbook.Sheets("Output").Visible = false部分放入 if nots then 部分，即使下載很好，當代碼位于 msgbox 之前時，它也會顯示訊息框。或者如果我在 go to 它觸發隱藏之前放置它并且更廣泛的代碼會掉落，因為我仍然需要此選項卡用于代碼的后續元素，然后再將其隱藏在其中。
我試圖將 else 段添加到代碼中，但找不到這些需要在適當的 end if 部分中去的地方，所以我不斷收到編譯錯誤。
根據要求編輯類目標代碼（格式奇怪，因為我不得不將其剪切為堆疊字符限制）
'
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
uj5u.com熱心網友回復：
“：”是在一行上合并許多陳述句
而不是這個宣告
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.
嘗試這個
If Not .IsLoginSuccessful Then
MsgBox "Login not successful", vbCritical vbOKOnly
ThisWorkbook.Sheets("Output").Visible = false
GoTo CleanExit
End if
uj5u.com熱心網友回復：
你可以試試這個
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
如果不是你想添加的位置，請糾正我，因為我是新成員，無法發表評論，這就是為什么不確認直接發布的原因。
如果你想在其他地方，那就說出來，我會盡力解決它。
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/494346.html
下一篇：如何根據列標題添加單元格值？