Post Project
  • Search
    • Buyers can
    • Search offers to buy now
    • Search freelancers to request a proposal
    • Freelancers can
    • Search projects to quote on
  • How it works
  • Log in
  • Sign up
  • Freelancer?
Browse by Category
    Technology & ProgrammingWriting & TranslationDesignDigital MarketingVideo, Photo & ImageBusinessMusic & AudioMarketing, Branding & SalesSocial Media

    Copy Folder Structure but No Files in VBA for Excel

    - or -

    Post a project like this
    12/05/2011
    £100(approx. $121)
    • Posted: 12 years ago
    • Proposals: 2
    • Remote
    • #68429
    • Expired
    Marius I.Andy M. have already sent a proposal.
    • 1
    • 1

    Description

    Experience Level: Intermediate
    My existing code does the following: copy prior month work folder (i.e. 201103) and create current month work folder (i.e. 201104) containing all the files, subfolders and files in subfolders from prior month work folder.

    I want to modify the existing code so that it only creates current month work folder with the subfolder structure under it, without any files either from the root (i.e. 201103) or subfolders. In other words, I only need the folder structure.

    It should be a quick change but since I only know a little bit of VBA, it is too hard for me .

    Here is the module for folder copying:
    Public Sub Initialize(DatabasePath As String, RunDate As Date, QueryExecutionType As ReportPackageQueryExecutionType)
    If Not Fso.FileExists(DatabasePath) Then
    Exit Sub
    End If

    mDatabasePath = DatabasePath

    Call UpdateStatus(\"Connecting to database...\")

    If mDb.State = ADODB.adStateOpen Then
    mDb.Close
    End If

    mDb.ConnectionString = \"Provider=Microsoft.Jet.OLEDB.4.0;\" _
    & \"Data Source=\" & mDatabasePath & \";\" _
    & \"Jet OLEDB:Database Password=\" & DB_PASSWORD & \";\"

    mDb.Open

    If mDb.State <> ADODB.adStateOpen Then
    Call UpdateStatus(\"Database connection failed.\")
    Exit Sub
    Else
    Call UpdateStatus(\"Database connection succeeded.\")
    End If

    mRunDate = RunDate

    Call mDateManager.Initialize(mRunDate)
    mReportDate = mDateManager.ReportDate
    mReportDatePriorMonth = mDateManager.GetLastDayOfMonthForDate(DateAdd(\"m\", -1, mReportDate))
    mPMonth = mDateManager.GetLastDayOfMonthForDate(DateAdd(\"m\", -1, ActiveWorkbook.Worksheets(1).Cells(3, 3)))
    Set mConfig = GetConfig(mDb)

    mReportRootPath = mConfig.Item(CONFIG_REPORT_DOCUMENT_ROOT_PATH)
    mNewlineCharacter = mConfig.Item(CONFIG_REPORT_FIELD_NEWLINE_CHAR)
    mSasExePath = mConfig.Item(CONFIG_SAS_EXE_PATH)
    mSasProgramName = mConfig.Item(CONFIG_SAS_PROGRAM_NAME)
    Call SetDebugEnabled(mConfig.Item(CONFIG_DEBUG_ENABLED))

    If Not Fso.FileExists(mSasExePath) Then
    Call ShowMessage(\"The SAS executable path for sas.exe was not found:\" & vbCrLf & vbCrLf & mSasExePath & \"Please update the default path in the [CF_REPORTS.mdb].[DB_CONFIG] table before proceeding.\", ErrorMessage, False)
    Exit Sub
    End If

    If Right(mReportRootPath, 1) <> \"\\\" Then
    mReportRootPath = mReportRootPath & \"\\\"
    End If

    If Not Fso.FolderExists(mReportRootPath) Then
    Call ShowMessage(\"The document root path was not found:\" & vbCrLf & vbCrLf & mReportRootPath & vbCrLf & vbCrLf & \"Please update the default path in the [CF_REPORTS.mdb].[DB_CONFIG] table before proceeding.\", StatusMessageType.ErrorMessage, False)
    Exit Sub
    End If

    \'mReportRootPriorMonthPath = mReportRootPath & mDateManager.FormatDateText(\"YYYYMM\", mReportDatePriorMonth, ReportDateFormat.YYYYMM) & \"\\\"
    mReportRootPriorMonthPath = mReportRootPath & mDateManager.FormatDateText(\"YYYYMM\", mPMonth, ReportDateFormat.YYYYMM) & \"\\\"
    If Not Fso.FolderExists(mReportRootPriorMonthPath) Then
    Call ShowMessage(\"Source files from the prior Run Date were not found:\" & vbCrLf & vbCrLf & mReportRootPriorMonthPath & vbCrLf & vbCrLf & \"Please copy this folder to the document root path before proceeding.\", StatusMessageType.ErrorMessage, False)
    Exit Sub
    End If

    mReportRootPath = mReportRootPath & mDateManager.FormatDateText(\"YYYYMM\", mReportDate, ReportDateFormat.YYYYMM) & \"\\\"
    mQueryExecutionType = QueryExecutionType

    Dim SourceFolder As Scripting.Folder
    Dim TargetFolder As Scripting.Folder

    Select Case mQueryExecutionType
    Case ReportPackageQueryExecutionType.Automated
    If Fso.FolderExists(mReportRootPath) Then
    mReportRootPath = Mid(mReportRootPath, 1, Len(mReportRootPath) - 1) & \"_\" & Format$(mRunDate, \"yyyymmdd_hhnnss\") & \"\\\"
    End If

    Set SourceFolder = Fso.GetFolder(mReportRootPriorMonthPath)
    Set TargetFolder = Fso.CreateFolder(mReportRootPath)

    Call UpdateStatus(\"Copying prior month\'s data...\")
    Call SourceFolder.Copy(TargetFolder.Path)
    Case ReportPackageQueryExecutionType.Manual
    If Not Fso.FolderExists(mReportRootPath) Then
    Set TargetFolder = Fso.CreateFolder(mReportRootPath)
    End If
    End Select

    Set TargetFolder = Nothing
    Set SourceFolder = Nothing

    mIsInitialized = True
    End Sub
    Kaixin Z.
    Kaixin Z.
    0% (0)
    Projects Completed
    -
    Freelancers worked with
    -
    Projects awarded
    0%
    Last project
    9 Feb 2023
    United States

    New Proposal

    Login to your account and send a proposal now to get this project.

    Log in

    Clarification Board Ask a Question

      There are no clarification messages.
    12/05/2011
    £100(approx. $121)

    - or -

    Post a project like this
    Kaixin Z.
    Kaixin Z.
    0% (0)
    Projects Completed
    -
    Freelancers worked with
    -
    Projects awarded
    0%
    Last project
    9 Feb 2023
    United States

    Related project Searches


    database microsoft access VBA programming language

    Product

    • About
    • Team
    • Careers

    Support

    • How it works
    • Trust & Safety
    • Help Centre

    Discover

    • GuidesStoriesNews

    Resources

    • Customer Stories
    • Business Cost Calculator
    • Startup Cities

    Browse

    • Freelance Services
    • Freelance Services By Country
    • Freelance Skills
    • Terms
    • Privacy
    • Sitemap
    • Company Details
    • © 2023 People Per Hour Ltd
    We collect cookies to enable the proper functioning and security of our website, and to enhance your experience. By clicking on 'Accept All Cookies', you consent to the use of these cookies. You can change your 'Cookies Settings' at any time. For more information, please read ourCookie Policy
    Cookie Settings
    Accept All Cookies