VBA - 搜索部分字符串的文本,复制整个字符串

时间:2013-07-01 14:27:55

标签: string vba full-text-search

我有一系列概述不同产品版本的文件,每个文件只用打印机作业编号命名。我想要做的是遍历我的文件夹中的每个这样的文件,打开它获取产品编号,并用该字符串重命名该文件。产品都以相同的前缀开头,但以下数字对每个产品都是唯一的。我已经知道我的宏提示用户输入该前缀了,但是我很难说如何搜索.txt文件,然后如何捕获所有内容直到下一个“空格”。每个产品系列都以不同的前缀开头,并且可能具有不同数量的后续数字。它只需要抓取前缀的第一个实例,到目前为止已经是第3行 - 但我不想将其限制为仅搜索该行,因为它可能在将来有所不同。

编辑: 这里的相关信息是“2940UB200L”。 “2940”是由用户给出的产品系列,以下值对于装配是唯一的。但是,此标题下方列出的同一产品系列中可能还有其他产品(我无法发布该列表)。这些Bills中的100个位于文件夹中,每个文件仅以打印作业编号命名。到目前为止,我真的只有一个弹出框的代码,请求产品系列前缀和循环文件夹的方法。其他一切都是点点滴滴,不能很好地协同工作。在给定的文件夹中,所有内容都应该来自同一产品系列。

示例文本...在预览中似乎没有像我粘贴的那样格式化:

生产工厂的法案条例
父母项目没有。圆环形 2940UB200L ENGR DRAW 00000LM000 / ZN31                             标准批量1.000相对SEQ RELATIVE SEQ组分工程量

等级编号。图纸数量

工作代码:

Sub ChangeFileName()

Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim ProdLine As String 'Product Line to search
Dim CatNum As String 'Full Part number
 'Get the folder object associated with the directory
With Application.FileDialog(msoFileDialogFolderPicker)
  .AllowMultiSelect = False

 'Close macro when no folder is selected
  If .Show <> -1 Then MsgBox "No folder selected! Exiting sub...": Exit Sub
  myDir = .SelectedItems(1)

  On Error Resume Next

  FolderName = .SelectedItems(1)
  Err.Clear

  On Error GoTo 0

End With

 'Gives File list a header
Set objFolder = objFSO.GetFolder(FolderName)
 'Prompts user for Product Line
ProdLine = InputBox("Enter product line prefix (example: 2940)")

 'Find Part Number
 'Change file name

End Sub

感谢任何输入

0 个答案:

没有答案