example :
'@openFile,打开文件
Function openFile(buf As String, fileName As String)
Dim temp As String
Dim template As String
template = ActiveWorkbook.Path & "\" & fileName
Open template For Input As #1
Do While Not EOF(1)
Line Input #1, temp
buf = buf & temp & vbCrLf
Loop
Close #1
End Function
Function GetFolder(Optional msg) As String
Dim bInfo As BROWSEINFO, pPath As String
Dim R As Long, X As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(msg) Then
bInfo.lpszTitle = "选择文件夹..."
Else
bInfo.lpszTitle = msg
End If
bInfo.ulFlags = &H1
X = SHBrowseForFolder(bInfo)
pPath = Space$(512)
R = SHGetPathFromIDList(ByVal X, ByVal pPath)
If R Then
pos = InStr(pPath, Chr$(0))
GetFolder = Left(pPath, pos - 1)
Else
GetFolder = ""
End If
End Function
'得到目标文件名
Public Function getDestFileName(ByVal fileName As String) As String
Dim pos1, pos2 As Integer
Dim destPath As String
pos1 = InStrRev(fileName, "\")
If (pos1 > 0) Then
fileName = Mid(fileName, pos1 + 1, (Len(fileName) - pos1))
End If
pos2 = InStrRev(fileName, ".")
If (pos2 > 0) Then
fileName = Mid(fileName, 1, pos2)
End If
destPath = Sheet1.Cells(20, 2).Value
getDestFileName = destPath & "\" & fileName & "cpy"
End Function
ref :http://www.excelperfect.com/index.php/technologybible/
https://msdn.microsoft.com/en-us/library/5z06z1kb.aspx