找到一个目录，当它不存在时创建它

【问题标题】：Finding a directory, creating it when it doesn't exist找到一个目录，当它不存在时创建它
【发布时间】：2016-02-24 13:51:19
【问题描述】：

我正在尝试在 excel 中创建一个宏，该宏会删除工作区中的所有信息并创建一个新文件（一个用于新一周的信息）。这个任务对我来说似乎很简单，但由于某种原因，我的代码的目录发现和创建部分正在返回我添加的“有问题”的 msgbox，以表明没有满足任何条件。我检查了语句中目录的拼写和位置，一切似乎都是正确的。我只需要一双全新的眼睛，因为我确信我在这一点上遗漏了一些明显的东西。

Sub DerpDate()
'--------------------------------------------------------------------------------------------------
'Subroutine that creates necessary directories, places new workbook in those directories and clears
'out old data before terminating
'--------------------------------------------------------------------------------------------------

'--------------------------------------------------------------------------------------------------
'                                           Declarations
'--------------------------------------------------------------------------------------------------
Dim NxtWk As Range, YrFind As Range, MonFind As Range, MonName As Range, _
LngName As String, DerpName As String, DelProd As Range, DelMold As Range, ProdSheet As Sheets, _
MoldSheet As Sheets, WindSheets As Sheets

    Set NxtWk = Sheets("Data").Range("B53")
    Set YrFind = Sheets("Data").Range("C53")
    Set MonFind = Sheets("Data").Range("D53")
    Set MonName = Sheets("Data").Range("E53")
    LngName = MonFind.Value & "-" & MonName.Value & "-" & YrFind.Value
    DerpName = "\\Jupiter\Production\2 Production Schedules\"

        'Production Ranges

        Set DelProd = Application.Union( _
        Sheets("Production Schedule").Range("H5:AB9"), Sheets("Production Schedule").Range("H15:AB23"), _
        Sheets("Production Schedule").Range("H29:AB30"), Sheets("Production Schedule").Range("H36:AB39"), _
        Sheets("Production Schedule").Range("H45:AB54"), Sheets("Production Schedule").Range("H60:AB62"), _
        Sheets("Production Schedule").Range("H68:AB73"), Sheets("Production Schedule").Range("H79:AB84"), _
        Sheets("Production Schedule").Range("H90:AB94"), Sheets("Production Schedule").Range("H100:AB101"), _
        Sheets("Production Schedule").Range("H107:AB112"), Sheets("Production Schedule").Range("H118:AB119"), _
        Sheets("Production Schedule").Range("H125:AB126"), Sheets("Production Schedule").Range("H132:AB133"), _
        Sheets("Production Schedule").Range("H139:AB140"), Sheets("Production Schedule").Range("H146:AB147"), _
        Sheets("Production Schedule").Range("H153:AB156"), Sheets("Production Schedule").Range("H162:AB166"), _
        Sheets("Production Schedule").Range("H172:AB175"), Sheets("Production Schedule").Range("H181:AB185"), _
        Sheets("Production Schedule").Range("H186:AB186"), Sheets("Production Schedule").Range("H192:AB193"))

        'Molding Ranges

        Set DelMold = Application.Union( _
        Sheets("Molders").Range("B5:W8"), Sheets("Molders").Range("B14:W20"), _
        Sheets("Molders").Range("B26:W31"), Sheets("Molders").Range("B37:W38"), Sheets("Molders").Range("B44:W45"), _
        Sheets("Molders").Range("B51:W54"), Sheets("Molders").Range("B60:W63"), Sheets("Molders").Range("B69:W72"), _
        Sheets("Molders").Range("C78:W93"))

        'Winding Ranges

        Set DelWind = Application.Union( _
        Sheets("Winders").Range("H5:AB6"), Sheets("Winders").Range("H8:AB9"), Sheets("Winders").Range("H11:AB12"), _
        Sheets("Winders").Range("H14:AB15"), Sheets("Winders").Range("H17:AB18"), Sheets("Winders").Range("H20:AB21"), _
        Sheets("Winders").Range("H23:AB24"), Sheets("Winders").Range("H26:AB27"), Sheets("Winders").Range("H29:AB30"), _
        Sheets("Winders").Range("H32:AB33"), Sheets("Winders").Range("H35:AB36"), Sheets("Winders").Range("H38:AB39"), _
        Sheets("Winders").Range("H41:AB42"), Sheets("Winders").Range("H44:AB45"), Sheets("Winders").Range("H47:AB48"), _
        Sheets("Winders").Range("H50:AB51"), Sheets("Winders").Range("H53:AB54"))

'--------------------------------------------------------------------------------------------------
'Booleans to determine what (if any) directories need to be created before a new workbook can be
'created
'--------------------------------------------------------------------------------------------------

    'See if the Year AND Month folder exist yet--save the new spreadsheet
    If Dir(DerpName & YrFind.Value & "\" & LngName) <> "" Then
    ActiveWorkbook.SaveAs Filename:=DerpName & YrFind.Value & "\" & LngName & "\" & NxtWk.Value & ".xlsm"

    'If the Year AND Month Folder don't exist, see if just the Year folder does--create Month folder
    'and save the new spreadsheet in it
    ElseIf Dir(DerpName & YrFind.Value) <> "" Then
    MkDir (DerpName & YrFind.Value & "\" & LngName)
    ActiveWorkbook.SaveAs Filename:=DerpName & YrFind.Value & "\" & LngName & "\" & NxtWk.Value & ".xlsm"

    'If the Year and Month Folder don't exist, create Year and Month folder and save the
    'new spreadsheet in it
    ElseIf Dir(DerpName) <> "" Then
    MkDir (DerpName & YrFind.Value)
    MkDir (DerpName & YrFind & "\" & LngName)
    ActiveWorkbook.SaveAs Filename:=DerpName & YrFind.Value & "\" & LngName & "\" & NxtWk.Value & ".xlsm"

    Else

    MsgBox ("Something is wrong with the file location operation in the DerpDate Subroutine")

    End If

'--------------------------------------------------------------------------------------------------
'Portion of the sub that removes old data from the new workbook
'--------------------------------------------------------------------------------------------------

    DelProd.ClearContents

    DelMold.ClearContents

    DelWind.ClearContents

End Sub

感谢您提供的任何帮助！

编辑：我已经改变了一些事情并且已经解决了我原来的问题。显示更改后，我返回路径/文件访问错误 (75)。

Dim NxtWk As Range, YrFind As Range, MonFind As Range, MonName As Range, _
LngName As String, DerpName As String, DelProd As Range, DelMold As Range, ProdSheet As Sheets, _
MoldSheet As Sheets, WindSheets As Sheets, MonDig As Range, DayDig As Range, FName As String

    Set NxtWk = Sheets("Data").Range("B53")
    Set YrFind = Sheets("Data").Range("C53")
    Set MonFind = Sheets("Data").Range("D53")
    Set MonName = Sheets("Data").Range("E53")
    LngName = MonFind.Value & "-" & MonName.Value & "-" & YrFind.Value
    DerpName = "\\Jupiter\ProductionSchedule\" & "2 Production Schedules"
    'DerpName = "C:\user\dwallace\desktop"
    Set MonDig = Sheets("Data").Range("B59")
    Set DayDig = Sheets("Data").Range("C59")
    FName = MonDig.Value & "-" & DayDig.Value & "-" & YrFind.Value
    YrFold = YrFind.Value

        'Production Ranges

        Set DelProd = Application.Union( _
        Sheets("Production Schedule").Range("H5:AB9"), Sheets("Production Schedule").Range("H15:AB23"), _
        Sheets("Production Schedule").Range("H29:AB30"), Sheets("Production Schedule").Range("H36:AB39"), _
        Sheets("Production Schedule").Range("H45:AB54"), Sheets("Production Schedule").Range("H60:AB62"), _
        Sheets("Production Schedule").Range("H68:AB73"), Sheets("Production Schedule").Range("H79:AB84"), _
        Sheets("Production Schedule").Range("H90:AB94"), Sheets("Production Schedule").Range("H100:AB101"), _
        Sheets("Production Schedule").Range("H107:AB112"), Sheets("Production Schedule").Range("H118:AB119"), _
        Sheets("Production Schedule").Range("H125:AB126"), Sheets("Production Schedule").Range("H132:AB133"), _
        Sheets("Production Schedule").Range("H139:AB140"), Sheets("Production Schedule").Range("H146:AB147"), _
        Sheets("Production Schedule").Range("H153:AB156"), Sheets("Production Schedule").Range("H162:AB166"), _
        Sheets("Production Schedule").Range("H172:AB175"), Sheets("Production Schedule").Range("H181:AB185"), _
        Sheets("Production Schedule").Range("H186:AB186"), Sheets("Production Schedule").Range("H192:AB193"))

        'Molding Ranges

        Set DelMold = Application.Union( _
        Sheets("Molders").Range("B5:W8"), Sheets("Molders").Range("B14:W20"), _
        Sheets("Molders").Range("B26:W31"), Sheets("Molders").Range("B37:W38"), Sheets("Molders").Range("B44:W45"), _
        Sheets("Molders").Range("B51:W54"), Sheets("Molders").Range("B60:W63"), Sheets("Molders").Range("B69:W72"), _
        Sheets("Molders").Range("C78:W93"))

        'Winding Ranges

        Set DelWind = Application.Union( _
        Sheets("Winders").Range("H5:AB6"), Sheets("Winders").Range("H8:AB9"), Sheets("Winders").Range("H11:AB12"), _
        Sheets("Winders").Range("H14:AB15"), Sheets("Winders").Range("H17:AB18"), Sheets("Winders").Range("H20:AB21"), _
        Sheets("Winders").Range("H23:AB24"), Sheets("Winders").Range("H26:AB27"), Sheets("Winders").Range("H29:AB30"), _
        Sheets("Winders").Range("H32:AB33"), Sheets("Winders").Range("H35:AB36"), Sheets("Winders").Range("H38:AB39"), _
        Sheets("Winders").Range("H41:AB42"), Sheets("Winders").Range("H44:AB45"), Sheets("Winders").Range("H47:AB48"), _
        Sheets("Winders").Range("H50:AB51"), Sheets("Winders").Range("H53:AB54"))

'--------------------------------------------------------------------------------------------------
'Booleans to determine what (if any) directories need to be created before a new workbook can be
'created
'--------------------------------------------------------------------------------------------------

    ActiveWorkbook.Save

    'See if a year directory exists.  If it doesn't, create it, then create the month directory, then
    'save the file.
    If Len(Dir(DerpName & "\" & YrFold)) = 0 Then
    MkDir (DerpName & "\" & YrFold)
    MkDir (DerpName & "\" & YrFold & "\" & LngName)
    ActiveWorkbook.SaveAs Filename:=DerpName & "\" & YrFold & "\" & LngName & "\" & FName & ".xlsm"

    'Assuming the Year directory exists, see if the third one (Month) exists. If it doesnt, create it and
    'save the file
    ElseIf Len(Dir(DerpName & "\" & YrFind & "\" & LngName)) = 0 Then
    MkDir DerpName & "\" & YrFold & "\" & LngName
    ActiveWorkbook.SaveAs Filename:=DerpName & "\" & YrFold & "\" & LngName & "\" & FName & ".xlsm"

    'Assuming all necessary directories already exist, save the file
    Else
    ActiveWorkbook.SaveAs Filename:=DerpName & "\" & YrFold & "\" & LngName & "\" & FName & ".xlsm"

    End If

'--------------------------------------------------------------------------------------------------
'Portion of the sub that removes old data from the new workbook
'--------------------------------------------------------------------------------------------------

    DelProd.ClearContents

    DelMold.ClearContents

    DelWind.ClearContents

End Sub

我唯一能想到的是，这是由于我正在尝试更改共享网络目录并且我没有看到用户设置。

【问题讨论】：

  • 提示：使用Debug.Print (DerpName &amp; YrFind.Value &amp; "\" &amp; LngName)检查目录地址是否正确。字符串中可以有前导或结束空格。
  • 这是中肯的建议。但是，我返回的是正确的文件路径，除非——按照 MS 的建议——它的格式不正确。当我使用 Debug.Print 时，它目前正在返回“\\jupiter\productionschedule\2 production schedules\2016\2-Feb-2016”。除非我需要驱动器号或其他东西（但驱动器号取决于个人用户），否则这完全是应该的。

标签： vba excel directory mkdir


【解决方案1】：

对于遇到此问题的任何人，我通过一些基于主题的谷歌搜索找到了答案。 MkDir 不太喜欢 UNC 文件路径。因此，无论我尝试什么格式化和连接都行不通。为了对 UNC 路径的网络位置执行相同的工作，您需要一个单独的 API 函数。我在这里找到了一篇很棒的文章：

http://www.devhut.net/2011/09/15/vba-create-directory-structurecreate-multiple-directories/

只需将 API 放在一个单独的模块中，然后在宏中使用您的 UNC 文件路径调用它。 API：

Public Sub MakeFullDir(strPath As String)
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\" 'Optional depending upon intent
    MakeSureDirectoryPathExists strPath
End Sub

宏示例：

Sub Example()
Dim filepath As String

filepath = "\\Server\Directory\SubDirectory\FolderYouWantToCreate"

Call MakeFullDir(filepath)

End Sub

API 实际上取代了 Boolean 和 MkDir，因为它执行这两个功能。

希望这对某人有所帮助！

【讨论】：

    猜你喜欢
    • 2011-02-18
    • 1970-01-01
    • 1970-01-01
    • 2014-01-15
    • 2011-04-12
    • 2014-10-08
    • 2022-01-10
    • 1970-01-01
    • 2012-04-24
    相关资源
    最近更新 更多
    热门标签
    Java Python linux javascript Mysql C# Docker 算法 前端 SpringBoot Redis Vue spring 设计模式 .net core .net kubernetes c++ 数据库 数据结构 大数据 js 机器学习 微服务 Android Go 程序员 面试 JVM ASP.net core 云原生 人工智能 后端 PHP git CSS golang k8s Nginx Django mybatis 深度学习 多线程 React 架构 devops 爬虫 云计算 Spring Boot LeetCode