错误1004 - 打开工作簿

时间:2016-01-22 18:28:53

标签: excel vba excel-vba

我尝试通过输入Dateconso在用户决定的文件夹中打开工作簿。在另一个工作簿中打开工作簿复制/粘贴。

问题是代码在打开文件时中断。

  

执行错误1004:'11400。找不到16.01.xlsm。

这里的工作簿名称是11400.16.01.xlsm,11400和16之间没有任何空格(即Dateconso)。

我知道它无法打开此工作簿,因为它不存在......但这不是我想要打开的工作簿!!!

Sub consolidation()
        '
        ' Macro

        ' Déclaration des variables
          Dim wb As Workbook
          Dim myPath As String
          Dim myFile As String
          Dim Dateconso As String


         'Optimisation de la Macro Speed
         Application.ScreenUpdating = True
         Application.EnableEvents = True


        'Sélection de la date
          Dateconso = InputBox("Quelle date souhaitez-vous consolider?","Question")
         If Dateconso = "" Then Exit Sub 'Si rien exit le  programme


         'Trouve les fichiers qui on la date associée
         myFile = Dir("Z:\7. Personnel\Florian\Projet_BDC\Test\*.xlsm")

    While myFile <> ""
        If InStr(myFile, Dateconso) > 0 Then 'si tu trouve la date recherchée, alors ouvre le fichier puis copie toute puis colle
           Set wb = Workbooks.Open(Filename:=myFile)
           wb.Worksheets(1).Range("A1").Select
           Range(Selection, Selection.End(xlToRight)).Select
           Range(Selection, Selection.End(xlDown)).Select
           Selection.Copy
           Workbooks("Consolidation.xlsm").Worksheets(2).Activate
           ActiveSheet.Paste
           wb.Close
           Else: MsgBox "Fichiers introuvables, vérifiez le format de date entré" 'Si il ne trouve rien, préviens l'utilisateur
           Exit Sub
        End If
        myFile = Dir()
    Wend


End Sub

1 个答案:

答案 0 :(得分:1)

这实际上与VBA误读文件名的方式无关。实际上,由于某种原因,在包含句点的文件名中需要修复(例如额外空格字符)。保留文件名。

问题是您没有提供路径以及文件名。 Dir function仅返回文件名,而不是完整路径。在使用之前,您需要重新添加路径。

Dim fp As String, fn As String

fp = "Z:\7. Personnel\Florian\Projet_BDC\Test\"
fn = Dir(fp & "*.xlsm")

While fn <> ""
    If InStr(fn, Dateconso) > 0 Then 'si tu trouve la date recherchée, alors ouvre le fichier puis copie toute puis colle
       Set wb = Workbooks.Open(Filename:=fp & fn)
            'do stuff
       wb.Close
       Else: MsgBox "Fichiers introuvables, vérifiez le format de date entré" 'Si il ne trouve rien, préviens l'utilisateur
       Exit Sub
    End If
    fn = Dir()
Wend