VBA学习笔记（2）之文件操作

今天学到了有关文件的创建以及读写的一些操作

Dim MyFile,MyName,MyPath

1.文件另存为

2.查找指定目录的文件名

MyName = Dir(MyPath,vbDirectory)  '指定的是在MyPath这个路径下的文件名，从第一个文件开始，这里我们可以做一个循环，循环体内不要忘记写上MyName=Dir，表示寻找下一个文件了

3.查找指定目录下指定后缀的文件名

MyFile= Dir（"C:\*.TXT"）此为寻找该目录下所有的txt文件，同样用loop来实现，MyFile= Dir（"C:\*.TXT"，vbHidden）表示隐藏的.txt文件，MyFile=Dir寻找下一个文件。*可以指定成具体的文件名，则无需循环

4.在指定目录下的文件里写入数据

Open MyPath & MyFile  For Append AS #1

Print #1,"这是追加的内容"

Close #1

代码事例：

'??
Private Sub Button_Submit_Click()
    Dim shp As Shape
    Sheets("sheet1").Copy
    For Each shp In ActiveSheet.Shapes
        shp.Delete
    Next
    'save as a file
    ActiveWorkbook.SaveAs Filename:=Range("B13"), FileFormat:=xlExcel8
   
   
    ActiveWorkbook.Close
     MsgBox "success"
    'read files
    Dim MyName, MyFile, MyPath
    Dim i&
    i = 1
    MyPath = Sheets("sheet1").[B11] & "\"
    MyName = Dir(MyPath, vbDirectory)
    Do While MyName <> ""
    If MyName <> "." And MyName <> ".." Then
        'If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then
        'ActiveSheet.Range("A1") = MyName
        Open Range("B13") For Append As #1
        Print #1, Cells(1, i).Value & MyName
        i = i + 1
        Close #1
       ' End If
    End If
    MyName = Dir  'search next directory
    Loop
    
   
目前上述代码有问题，那个Cells(1, i).Value&; MyName是没有成功的，是过了Cells(1, i).Value = MyName，无论如何都没有成功，其他的都是对的.

3Private Sub Button_Submit_Click()
    Dim shp As Shape
    Sheets("sheet1").Copy
    For Each shp In ActiveSheet.Shapes
        shp.Delete
    Next
    'save as a file
    ActiveWorkbook.SaveAs Filename:=Range("B13"), FileFormat:=xlExcel8
   
   
    ActiveWorkbook.Close
     MsgBox "success"
    'read files
    Dim MyName, MyFile, MyPath
    Dim i&
    i = 1
    MyPath = Sheets("sheet1").[B11] & "\"
    MyName = Dir(MyPath, vbDirectory)
    Set wb = Workbooks.Open(Range("B13"))
    Do While MyName <> ""
    If MyName <> "." And MyName <> ".." Then
        'If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then
        'ActiveSheet.Range("A1") = MyName
       
        'Open Range("B13") For Append As #1
        'Print #1, Sheets("sheet1").Cells(1, i).Value = MyName
        'With ThisWorkbook.Sheets(1)
        wb.Sheets(1).Cells(1, i) = MyName
        i = i + 1
       ' Close #1
       ' End If
       'End With
    End If
    MyName = Dir  'search next directory
    Loop
    wb.Close
    
End Sub
三月二十八日更新内容如下：

由于上述代码的写入问题有误，后是用set来设置文件对象比较好用，可以将指定的内容写入指定路径下的制定文件的单元格内，如下代码成功解决了上述问题：

Private Sub Button_Submit_Click()
    Dim shp As Shape
    Sheets("sheet1").Copy
    For Each shp In ActiveSheet.Shapes
        shp.Delete
    Next
    'save as a file
    ActiveWorkbook.SaveAs Filename:=Range("B13"), FileFormat:=xlExcel8
   
   
    ActiveWorkbook.Close
     MsgBox "success"
    'read files
    Dim MyName, MyFile, MyPath
    Dim i&
    i = 1
    MyPath = Sheets("sheet1").[B11] & "\"
    MyName = Dir(MyPath, vbDirectory)
    Set wb = Workbooks.Open(Range("B13"))
    Do While MyName <> ""
    If MyName <> "." And MyName <> ".." Then
        'If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then
        'ActiveSheet.Range("A1") = MyName
       
        'Open Range("B13") For Append As #1
        'Print #1, Sheets("sheet1").Cells(1, i).Value = MyName
        'With ThisWorkbook.Sheets(1)
        wb.Sheets(1).Cells(1, i) = MyName
        i = i + 1
       ' Close #1
       ' End If
       'End With
    End If
    MyName = Dir  'search next directory
    Loop
    wb.Close
    
End Sub