Visual Basic

Function zGetFolder( sFolder )
    On Error Resume Next
    Set zGetFolder = oFso.GetFolder( sFolder )
    If Err.Number <> 0 Then
        Wscript.Echo "Error connecting to: " & sFolder & VBlf & "[" & Err.Number &  "]" & Err.Description
        Wscript.Quit Err.Number
    End If
End Function

Quote:

************** Exception Text **************
System.IndexOutOfRangeException: Index was outside the bounds of the array.
at VGProfilesAP9.dlgProfiler.Build_FromToLists() in C:\Users\3811\Desktop\AP9 40 STORES TWO\AP9\VGProfilesAP9\VGProfilesAP9\Profiler.vb:line 156
at VGProfilesAP9.dlgProfiler.Profiler_Load(Object sender, EventArgs e) in C:\Users\3811\Desktop\AP9 40 STORES TWO\AP9\VGProfilesAP9\VGProfilesAP9\Profiler.vb:line 84
at System.EventHandler.Invoke(Object sender, EventArgs e)
at System.Windows.Forms.Form.OnLoad(EventArgs e)
at System.Windows.Forms.Form.OnCreateControl()
at System.Windows.Forms.Control.CreateControl(Boolean fIgnoreVisible)
at System.Windows.Forms.Control.CreateControl()
at System.Windows.Forms.Control.WmShowWindow(Message& m)
at System.Windows.Forms.Control.WndProc(Message& m)
at System.Windows.Forms.ScrollableControl.WndProc(Message& m)
at System.Windows.Forms.Form.WmShowWindow(Message& m)
at System.Windows.Forms.Form.WndProc(Message& m)
at System.Windows.Forms.Control.ControlNativeWindow.OnMessage(Message& m)
at System.Windows.Forms.Control.ControlNativeWindow.WndProc(Message& m)
at System.Windows.Forms.NativeWindow.Callback(IntPtr hWnd, Int32 msg, IntPtr wparam, IntPtr lparam)

<pre>
Public Class dlgProfiler
    Dim storeCount As Integer
    Dim IsInit As Boolean = False
    Dim nmeArr(0 To 999) As String
    Dim importVGArr(0 To 999) As String
    Dim totSales As Double = 0
    Dim nodeFound As Boolean
    Dim nodecount As Long
    Dim WK1, WKL, bWK1, bWKL As Int32
    Dim webSales As Double
    Dim EditMode As Boolean = False
    Dim SavedProfID As Integer = 0
    Dim HNRID_IN As String

    Private Sub Profiler_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        Dim defaultVGDB9 = GetSetting("AsstPlan", "Settings", "DefaultVGP9db", "")
        Select Case UCase(Mid(System.Environment.GetEnvironmentVariable("SessionName"), 1, 3))
            Case "CON"
                MY_AP9_PATH = Application.StartupPath
                If File.Exists(defaultVGDB9) Then
                    If defaultVGDB9 = MY_AP9_PATH & "\MyVGP9.accdb" Then
                        Me.optProfileDB_ThisComputer.Checked = True
                        SharedProfileDatabase = GetSetting("AsstPlan", "Settings", "SharedVGP9db", "")
                        If File.Exists(SharedProfileDatabase) Then
                            optProfileDB_Shared.Text = "Shared AP9 Profiles (from " & SharedProfileDatabase & ")"
                        Else
                            optProfileDB_Shared.Text = "Shared AP9 Profiles (currently not linked - click to search)"
                            SaveSetting("AsstPlan", "Settings", "SharedVGP9db", "")
                        End If
                    Else
                        Me.optProfileDB_Shared.Checked = True
                        optProfileDB_Shared.Text = "Shared AP9 Profiles (from " & defaultVGDB9 & ")"
                        SaveSetting("AsstPlan", "Settings", "SharedVGP9db", defaultVGDB9)
                        optProfileDB_Shared.Text = "Shared AP9 Profiles (from " & defaultVGDB9 & ")"
                        SharedProfileDatabase = defaultVGDB9
                    End If
                    cmdSharedDBFind.Left = optProfileDB_Shared.Right + 10
                    cmdSharedDBCreate.Left = optProfileDB_Shared.Right + 100
                    CurrentProfileDatabase = defaultVGDB9
                Else
                    If File.Exists(MY_AP9_PATH & "\MyVGP9.accdb") Then
                        CurrentProfileDatabase = MY_AP9_PATH & "\MyVGP9.accdb"
                        SaveSetting("AsstPlan", "Settings", "DefaultVGP9db", CurrentProfileDatabase)
                    Else
                        If MsgBox("An AP9 profiles database file has not been installed this computer yet. A new blank file will be opened in the asst planning " &
                                    "folder." & vbCrLf & vbCrLf & "If you click cancel, the profiler application will terminate without creating that file.",
                                    vbOKCancel + vbExclamation, "AP9 Profile Datafile Not Found") = vbOK Then
                            If File.Exists(AP_PATH & "MyVGP9.accdb") = True Then
                                File.Copy(AP_PATH & "MyVGP9.accdb", MY_AP9_PATH & "\MyVGP9.accdb")
                                CurrentProfileDatabase = MY_AP9_PATH & "\MyVGP9.accdb"
                                SaveSetting("AsstPlan", "Settings", "DefaultVGP9db", CurrentProfileDatabase)
                            Else
                                MsgBox("Cannot connect to public drive to create file. Application will end", vbOKOnly + vbCritical, "Not connected")
                                End
                            End If
                        Else
                            End
                        End If
                    End If
                End If
            Case "ICA"
                If File.Exists(defaultVGDB9) Then
                    CurrentProfileDatabase = defaultVGDB9
                Else
                    If MsgBox("When working through Citrix, only 'Shared' profiles database files are available. (Shared files are stored on a network drive like the I:\ drive.) " & _
                           "Have you already created a shared database on the I:\ drive?", MsgBoxStyle.YesNo + MsgBoxStyle.Question, "Shared VG Profiles Database") = vbYes Then
                        If FindSharedProfileDB() = False Then End
                    Else
                        If MsgBox("Do you want to create one? (Yes to create a new file, No toexit the application)", MsgBoxStyle.YesNo + MsgBoxStyle.Question, "Create New Shared VG9 Database") = vbYes Then
                            CreateSharedVGDB()
                        Else
                            End
                        End If
                    End If
                End If

        End Select
        cnMID = New ADODB.Connection
        cnMID.Open("DRIVER={SQL SERVER};SERVER=Mid.sqldb.prod.myco.com;DATABASE=MID", "User", "user")
        InitStoreNames()
        BuildVersionList()
        Build_SeasonYearLists()
        Build_FromToLists()
        BuildUserList()
        GR3.RowTemplate.Height = 18

        SetGrids(300)
        SetToolTips()
        LoadMyProfiles()
    End Sub

    Public Sub SetToolTips()
        Dim toolTips As New ToolTip()
        ' Set up the delays for the ToolTip.
        toolTips.AutoPopDelay = 8000
        toolTips.InitialDelay = 1000
        toolTips.ReshowDelay = 500
        toolTips.ShowAlways = True
        ' Set up the ToolTips for controls
        toolTips.SetToolTip(cmdImport_Excel, "Create and open an Excel sheet with 3 colums with Store, Sales, and optionally Vgroup letter A-O")
        'toolTips.SetToolTip(cmdConvert, "Converts profiles from the older AP6/AP7 assortment planning system to the new format")
        toolTips.SetToolTip(cmdCopyVG, "Allows you to copy profile to/ from a shared profiles file to the file on your computer.")
    End Sub

    Private Sub dlgProfiler_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
        cnMID.Close() : cnMID = Nothing
    End Sub

    Private Sub InitStoreNames()
        Dim RSS As New ADODB.Recordset
        Dim SQL1 As String = "SELECT ST_ID, STORE_NAME FROM dbo.STORES ORDER BY ST_ID ASC"
        RSS.Open(SQL1, cnMID, 3, 1, 1)
        Do Until RSS.EOF
            If Val(RSS.Fields("ST_ID").Value) > 0 Then
                nmeArr(RSS.Fields("ST_ID").Value) = RSS.Fields("STORE_NAME").Value
            End If
            RSS.MoveNext()
        Loop
        RSS.Close()
    End Sub

    Private Sub BuildVersionList()
        Dim RSV As New ADODB.Recordset
        Dim SQL1 As String = "SELECT dbo.FORECAST_VERSION.FV_RID, dbo.FORECAST_VERSION.DESCRIPTION From dbo.FORECAST_VERSION WHERE (((dbo.FORECAST_VERSION.FV_ID) IN('A','C','Z'))) ORDER BY dbo.FORECAST_VERSION.DESCRIPTION ASC"
        RSV.Open(SQL1, cnMID, 3, 1, 1)
        Dim vList As New ArrayList
        Dim vListB As New ArrayList
        Do Until RSV.EOF
            vList.Add(New MIDVersion(RSV.Fields(1).Value, RSV.Fields(0).Value))
            vListB.Add(New MIDVersion(RSV.Fields(1).Value, RSV.Fields(0).Value))
            RSV.MoveNext()
        Loop
        cboH_PlanVersion.DataSource = vList
        cboH_PlanVersion.DisplayMember = "Version_Name"
        cboH_PlanVersion.ValueMember = "Version_Code"
        RSV.Close() : RSV = Nothing
        cboH_PlanVersion.SelectedIndex = 2
    End Sub

    Private Sub Build_FromToLists()
        Dim wkList(0 To 207) As String
        Dim year1 As Integer = Year(Now) - 2
        Dim wkIndex As Integer = 0
        Dim currFweek As Long = MID_GetCurrFiscalWeek()
        Dim currFweekIndex As Integer = 0
        For yr = year1 To year1 + 3
            If yr = 2017 Then
                For wk = 1 To 53
                    wkList(wkIndex) = CStr(yr) & " Wk" & Format(wk, "00")
                    If (yr * 100) + wk = currFweek Then currFweekIndex = wkIndex
                    wkIndex += 1
                Next wk
            Else
                For wk = 1 To 52
                    wkList(wkIndex) = CStr(yr) & " Wk" & Format(wk, "00")
                    If (yr * 100) + wk = currFweek Then currFweekIndex = wkIndex
                    wkIndex += 1
                Next wk
            End If
        Next yr
        cboTime_From.Items.AddRange(wkList)
        cboTime_To.Items.AddRange(wkList)
        If currFweekIndex > 0 Then
            cboTime_From.SelectedIndex = currFweekIndex - 1
            cboTime_To.SelectedIndex = currFweekIndex
        End If
    End Sub