Sub JoinCSV()
    Dim pachb As String, path1 As String, path2 As String
    'pachb = Application.CurrentProject.Path
    pachb = "C:"
    path1 = pachb & "\Files\"
    path2 = pachb & "\OneFile\"
    Call Shell("cmd /c copy """ & path1 & "*.csv"" """ & path2 & "Joined.csv""")
End Sub

Sub OpenADODB()
    Set cn = New ADODB.Connection
    cn.ConnectionString = "Provider=SQLOLEDB;Data Source=MVOLITTLE;" & _
                  "Initial Catalog=LittleHouseView;" & _
                  "User ID=логин;Password=пароль;"
    cn.Open
End Sub

Sub LoadPictureFromDB()
    Dim strStream As New ADODB.Stream
    Dim rs As ADODB.Recordset
    
    Call OpenADODB
    Set rs = New ADODB.Recordset
    
    With rs
        .ActiveConnection = cn
        .Open "select * from [dbo].[сКартинки] К where К.артикул = '48435';"
    End With
    
    Set strStream = New ADODB.Stream
    strStream.Type = adTypeBinary
    strStream.Open
    
    strStream.Write rs.Fields("Поле с картинкой").Value
    strStream.SaveToFile "C:\Temp\Temp.jpg", adSaveCreateOverWrite

End Sub

cbPeriodTo.List = Country

cbPeriodTo.RowSource = "[" & ThisWorkbook.Name & "]" & shLists.Name & "!" & rgCountry.Address

Function HasFormula(cell As Range) As Boolean
    HasFormula = cell.HasFormula
End Function

Function HasLink(cell As Range) As Boolean    
   With cell
        If .HasFormula Then
            If InStr(1, .Formula, "[") <> 0 And InStr(1, .Formula, "]") Then
                HasLink = True
            Else
                HasLink = False
            End If
        Else
            HasLink = False
        End If
    End With
    
End Function
 

Private Sub Workbook_Open()
    Sheets(1).Activate
    With Application
        If .UserName = "dmitriy_po" Then
            .DisplayAlerts = False
        End If
     End With
 End Sub 

   Dim vPath As Variant
   Dim stSave As String
   Dim stFilter As String
   Dim bOpenReport As Boolean
   ...
   stFilter = "Книга Excel (*.xlsx), *.xlsx,Книга Excel 97-2003(*.xls),*.xls,Двоичная книга Excel(*.xlsb), "
   stFilter = stFilter + "*.xlsb,Книга Excel с поддержкой макросов (*.xlsm), *.xlsm"
   vPath = Application.GetSaveAsFilename("", stFilter, , "Saving Roaming Statistic Report for " & cbCountry.Value)
   ...
   
      stSaveAs = vPath   
   ...
    Application.SheetsInNewWorkbook = 1
    Set wrbReport = Workbooks.Add
   ...
    With wrbReport
      If stSaveAs <> "<no path specified>" Then
                  .SaveAs stSaveAs, xlLocalSessionChanges
               End If
              .Close SaveChanges:=True
           End If
    End With

Sub RunCasePerCountry(Optional dPeriodFrom As Date = #7/1/2013#, Optional dPeriodTo As Date = #6/1/2014#, Optional stCountry As String = "Brazil", _
    Optional stCurrency As String = "EUR", Optional stSaveAs As String, Optional bOpenReport = True)
    
    Dim MyDatabase As DAO.Database
    Dim MyRecordset As DAO.Recordset
    Dim stPeriodFrom As String, stPeriodTo As String
    Dim MyQuery As String
    Dim i As Integer, c As Integer
    Dim wrbReport As Workbook
    Dim shtData As Worksheet, shtReport As Worksheet
    
    stPeriodFrom = Month(dPeriodFrom) & "/" & Day(dPeriodFrom) & "/" & Year(dPeriodFrom)
    stPeriodTo = Month(dPeriodTo) & "/" & Day(dPeriodTo) & "/" & Year(dPeriodTo)
    
    Application.ScreenUpdating = False
    
    MyQuery = "SELECT tDirection.DIR_NAME AS Direction, tPeriod.YEAR_ AS [Year], tPeriod.MTH_NUM AS [Month], tPeriod.PERIOD AS Period, tCountry.COUN_NAME AS Country, "
    MyQuery = MyQuery + "qUnionTrafficAll.TAP_CODE AS [TAP Code], qTAP_DP_Status.DP_NAME AS [Discount Partner], IIf([tDiscountStatus].[ST_NAME] Is Null,'No Discount',"
    MyQuery = MyQuery + "[tDiscountStatus].[ST_NAME]) AS Status, tTraffic_EDS.TRF_NAME AS Service, tPartner.PART_NAME AS Partner, qUnionTrafficAll.NUM_CED AS Traffic, "
    MyQuery = MyQuery + "[qUnionTrafficAll].[S_GR_CH]*[qSDRRates_" & stCurrency & "].[SDR_RATE] AS [Gross Charge], "
    MyQuery = MyQuery + "IIf([qDiscountTariffs_" & stCurrency & "].[IOT_DISC] Is Null,[Gross Charge],[qDiscountTariffs_" & stCurrency & "].[IOT_DISC]*[qUniontrafficAll].[NUM_CED]) AS [Net Charge], "
    MyQuery = MyQuery + "[Net Charge]/[qUniontrafficAll].[NUM_CED] AS [Actual Rate], qDiscountTariffs_" & stCurrency & ".IOT_DISC "
    MyQuery = MyQuery + "FROM (tCountry INNER JOIN tPartner ON tCountry.COUN_CODE = tPartner.COUNT_CODE) INNER JOIN (((tCallEventDetail INNER JOIN "
    MyQuery = MyQuery + "(((tPeriod INNER JOIN (((qUnionTrafficAll LEFT JOIN qDiscountTariffs_" & stCurrency & " ON (qUnionTrafficAll.DIR_CODE = qDiscountTariffs_" & stCurrency & ".DIR_CODE) AND "
    MyQuery = MyQuery + "(qUnionTrafficAll.YEAR_ = qDiscountTariffs_" & stCurrency & ".YEAR_) AND (qUnionTrafficAll.MTH_NUM = qDiscountTariffs_" & stCurrency & ".MTH_NUM) AND "
    MyQuery = MyQuery + "(qUnionTrafficAll.CED_CODE = qDiscountTariffs_EUR.CED_CODE) AND (qUnionTrafficAll.SF1_CODE = qDiscountTariffs_" & stCurrency & ".SF1_CODE) AND "
    MyQuery = MyQuery + "(qUnionTrafficAll.TAP_CODE = qDiscountTariffs_EUR.TAP_CODE)) LEFT JOIN qSDRRates_" & stCurrency & " ON (qUnionTrafficAll.YEAR_ = qSDRRates_" & stCurrency & ".YEAR_) AND "
    MyQuery = MyQuery + "(qUnionTrafficAll.MTH_NUM = qSDRRates_EUR.MTH_NUM)) INNER JOIN tServiceFamily1 ON qUnionTrafficAll.SF1_CODE = tServiceFamily1.SF1_CODE) ON "
    MyQuery = MyQuery + "(tPeriod.MTH_NUM = qUnionTrafficAll.MTH_NUM) AND (tPeriod.YEAR_ = qUnionTrafficAll.YEAR_)) INNER JOIN tDirection ON "
    MyQuery = MyQuery + "qUnionTrafficAll.DIR_CODE = tDirection.DIR_CODE) INNER JOIN tTAP ON qUnionTrafficAll.TAP_CODE = tTAP.TAP_CODE) ON tCallEventDetail.CED_CODE = "
    MyQuery = MyQuery + " qUnionTrafficAll.CED_CODE) LEFT JOIN qTAP_DP_Status ON (qUnionTrafficAll.TAP_CODE = qTAP_DP_Status.TAP_CODE) AND (qUnionTrafficAll.YEAR_ = qTAP_DP_Status.YEAR_) "
    MyQuery = MyQuery + "AND (qUnionTrafficAll.MTH_NUM = qTAP_DP_Status.MTH_NUM)) INNER JOIN tTraffic_EDS ON (tServiceFamily1.SF1_CODE = tTraffic_EDS.SF1_CODE) "
    MyQuery = MyQuery + "AND (tCallEventDetail.CED_CODE = tTraffic_EDS.CED_CODE)) ON tPartner.PART_CODE = tTAP.PART_CODE "
    MyQuery = MyQuery + "WHERE (((tPeriod.PERIOD) Between #" & stPeriodFrom & "# And #" & stPeriodTo & "#) AND ((tCountry.COUN_NAME)='" & stCountry & "'))"
    
    Set MyDatabase = DBEngine.OpenDatabase("\\palladium_zdm\data\NetStorage\Int_roam\Polishchuk\Roaming Partners Traffic Database\Roaming Statistic Database.mdb")
     
    Set MyRecordset = MyDatabase.OpenRecordset(MyQuery)
    
    Application.SheetsInNewWorkbook = 1
    Set wrbReport = Workbooks.Add
    
    With wrbReport
        Set shtData = .Sheets(1)
        shtData.Name = "Data"
        ThisWorkbook.Sheets("Model").Copy before:=shtData
        Set shtReport = .Sheets("Model")
        shtReport.Name = "Report"
    End With
    
    With shtData
        .Select
        .UsedRange.ClearContents  
     .Range("A2").CopyFromRecordset MyRecordset ' ОШИБКА ВОЗНИКАЕТ В ЭТОМ МЕСТЕ
        For i = 1 To MyRecordset.Fields.Count
            .Cells(1, i).Value = MyRecordset.Fields(i - 1).Name
        Next i
    End With    
    
    With wrbReport
        If stSaveAs <> "<no path specified>" Then
            .SaveAs stSaveAs
            If bOpenReport = False Then
                .Close
            End If
        End If
    End With
    
    MsgBox "Your Query has been Run"    
End Sub 

    With ThisWorkbook.Worksheets("Lists")
        Set rgCountry = .Range(.Range("A2"), .Range("A2").End(xlDown))
        Set rgCurrency = .Range(.Range("B2"), .Range("B2").End(xlDown))
        Set rgPeriod = .Range(.Range("C2"), .Range("C2").End(xlDown))
    End With 

Set wbLists = ThisWorkbook.Worksheets("Lists")

With wbLists.Cells
        Set rgCountry = .Range(.Range("A2"), .Range("A2").End(xlDown))
        Set rgCurrency = .Range(.Range("B2"), .Range("B2").End(xlDown))
        Set rgPeriod = .Range(.Range("C2"), .Range("C2").End(xlDown))
    End With 

Set wbLists = ThisWorkbook.Worksheets("Lists")

With wbLists.Cells
        Set rgCountry = .Range(.Range("A2"), .Range("A2").End(xlDown))
        Set rgCurrency = .Range(.Range("B2"), .Range("B2").End(xlDown))
        Set rgPeriod = .Range(.Range("C2"), .Range("C2").End(xlDown))
    End With